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I. INTRODUCTION 


A. BACKGROUND 


The NPS MICRO-COBOL Compiler/Interpreter was initially 
(1976) [2] developed to demonstrate that it was feasible to 
implement a COBOL compiler on a microcomputer. It was known 
that the COBOL language used would have to be a subset of 
ANSI COBOL because of the restriction imposed by the size of 
a microcomputer memory. A subset of ANSI COBOL, specifically 
the Navy’s Automated Data Proecessing Equipment Selection 
Office (ADPFSO) HYPO-COBOL [4], was selected as the basis 
for the implementation. Additional motivation was provided 
by the DOD requirement that all computers used in a 
non-tactical environment be capable of executing COFROL 
programs. 

The previous work was directed toward six major areas: 
1.) selecting a suitable COBOL subset to operate on, 2.) 
developing the associated grammar for the language, 3.) 
determining what type of compiler to design, 4.) designing 
mmemcoding the corpiler, 5.) designing and coding the 
interpreter, and 6.) testing and debugging of the storage 
allocation and symbol table entries of tne comviler. 

The choice of a suitable language was originally based 
on BYPO-COROL, since this is a Department of the Navy 


approved subset of COFOL, designed to vlace minimal 





requirements on a system for compiler support. Where 
possible, short constructs were used in the place of longer 
ores. Where more than one reserved word served the same 
function in COBOL the shortest form was used. There is no 
optional verbage in the language, and no duplicate 
constructs perform the same function. Limits were placed on 
all statements that had a variable input format so that all 
Statements had a fixed maximum length. Where possible, such 
constructs were removed completely from the language. In 
addition, user defined identifier names were limited to 
twelve chéracters to reduce symbol table storage 
requirements. 

Rather than include Pele Standard revels of 
implementation HOtmuatie —Of the modules “In HY PO=COLOL, 
constructs were included only as required. In addition to 
low level constructs, THE PERFORM UNTIL was included to 
a€allow better program structure. Further justificatior for 
the manner of subsetting and a highly detailed description 
of each element of the languege is contained in the 
HYPO-COBOL language specifications reference 3. 

The grammar for the MICRO-COBOL language was defined as 
LALR(1). The compiler design was based on a table-driven 
parser for the LALR(i1) grammar. The algorithm used to 
develope the parse tables for the compiler was developed by 
W. R. Lalonge [28]. 


The basic design and coding of tne compiler and 





Maverpreter was completed prior to the current thesis work 
Mmameocott Atlan Craig [3]. Modification to the original 
thesis work was conducted by Phil Mylet [18]. Initial 
testing and debugging of Part One was conducted by Jim 


Farlee and Michael Rice(9}. 


B. OPERATING ENVIRONMENT 


The NPS MICRO-COBOL compiler and interpreter are 
designed to run under the CP/M operating system on an 8282 
or Z88 based microcomputer with at least 2eK bytes of main 
memory. The compileér programs are designed to use no more 
than 14 bytes of main memory, while the interpreter program 
uses aporoximately 12K bytes. The compiler and interpreter 
require S2K bytes of disk storage for the progrars that make 
up the compiler/interpreter package. For information on 
creating MICRO-COBOL source programs and CP/M see references 


Seand 6. 


SemecOALS AND OBJECTIVES 


The major goals of this work were 1.) Modify the 
existing compiler to allow use of the ADPESO validation test 
programs, 2.) Corr2ct all known errors as outlined by Farlee 
and Ricef{i8s], 2%.) Implement all constructs not previously 
implemented, 4.) Verify that NPS MICRO-COBOL met HYPO-COROL 


Standards, and 5.) Fxtend the existing compiler/interpreter 
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package with some of the more frequently used high level 
COBOL constructs. 

In addition to the above goals, it was considered 
beneficial to update and incorporate all previous 
documentation 5 Jeurg®) the present NPS MICRO-COBOL 
compiler/interpreter documentation. This documentation is 


included in this thesis. 


D. PROBLEM DEFINITION 


For software performance assessment, a series of simple 
COBOL source programs and the Navy ALPESO BYPO-COBOL [4] 
validation test programs (HCCVS) were compiled and execution 
masgmattempted. Initial results of the ADPSSO validation test 
programs produced over 4@@ compile and run time errors. Some 
of the errors were known previously as outlined in the 
previous thesis work by Farley and Rice([9]. The elimination 
of these problems plus the goals outlined above formed the 


mownaation for this thesis. 


E. PROBLEM SOLUTION 


The ADPESO validation test programs could rot te used 
for testing the compiler/interoreter until three areas were 
corrected. 1.) File I/0 was inadequate to generate usable 
intermediate code, 2.) the IF-THEN-ELSE construct would not 


allow multiple statements to be performed, and 3.) the Move 


3 
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Numeric Ydited command was not implemented. The file I/0 
problem was corrected by Doug Loskot{15] as a class project 
Carly in this thesis effort. A new [F-THEN—-FLSE construct 
allowing the use of multiple statements in doth the ‘THEN 
and “ELSE” clauses was implemented by Robert Hartel and Doug 
Stowers[19] as another class project. Implementation of the 
Move Numeric Edited command was completed by the author 
early in the thesis effort and allowed the validation test 
programs to be used for testing. 

Once the validation programs could oe compiled and 
executed, testing and debugging continued at a more rapid 
pace. All the errors exposed by the test programs as well as 
the known errors outlined in Appendix G of Farlee and 
Rice{9] were corrected, with the exception of the tests 
dealing with the Interprogram Communication Module. 

mapa erarmer in Part Two of the compiler wes not 
Gonmstructed to allow the name of a called program to be 
Stored. This required a change to the existing grammar. In 
addition to modifing the grammar for subroutine calls, a 
change to allow nesting IF-THEN-FLSE, NEXT SENTENCE option, 
the PERFORM VARYING verb, the COMPUTE verb and the legical 
operators AND and “OR” were defined in the grammar. 

the grammar charge was implemented in two steps. First 
the IF-THEN-FLSE statement, which included nesting and an 
END-IF clause, and the PERFORM VARYING statement was 


implemented as a class project by Carol Cagle[2]. The 


he 





present grammer is the result of the second change and 
mecludes the COMPUTE verb, logical operators, GIVING clause 
for the arithemetic operators and the charge that enabdled 
implementation of the Interprogram Communications module. In 
it’s present form all of the specifications of FYPO-COBOL 
ape met or exceeded. Ir addition to the COnstunucts 
previously mentioned the new grammar will be able make the 
Environment division optional, handle aut peragraphs 
(paragraphs with no statements) and rultiple open, close, 
display, add, and Suptrea ct statements as well as 
multi-dimrensional tables. Appendix G contains a list of 
constructs that have been defined in the grammar but not yet 


implerented. 


FP. SYSTEM OVERVIEW 


NPS MICRO-CCOBOL is a compiler/interpreter package. The 
compiler consists of three modules that combine to produce 
mero Sseune sarst file is an intermediate code file and 
the second is a list file containing any compilation errors 
forme Line that caused the error. The first and second 
moeamres are combined together to form a module called 
COBOL.COM. The command cCOROL <file name> initiates the 
compilation sequence. The first module (PART I) opens the 
Input file, list file and code file, moves the second 


module, READER, to high memory for later use, and then 


13 





starts compiling the input file through the word PROCEDURE 
in the sentence PROCEDURE DIVISICN. The symbol table is 
built starting at a storage location just above PART I and 
can use all available memory up to the base of the READER 
routine previously moved to high memory. After PPOCEDURF is 
parsed cortrol is transfered to the READER routine which 
then copies the third module (PART II), into memory over 
PART I. Compilation continues to the end of the input file 
using the symbol table constructed from PART I. The symbol 
table can be added to by PART II up to and including the 
area previously used by the READER routine as REAPER is ne 
longer needed. This scheme allows the use of all available 
free memory for the symbol table. At the end of the input 
file all fi11es are closed and the compilation process is 
complete. 

Error recovery/management is accomplished using the ad 
hoc panic mode technique discussed in Aho and Ullran [1]. 
Errors are anrnouced to the user by a two letter code. The 
user is required to look up the meanings of these codes in 
Maer to understand the full significance of C€ach error but 
it was felt that this technique wes necessary to keep the 
size of the compiler/interpreter package to a minimum. 

The command EXEC <file name> causes the load routine 
BUILD to be loaded into memory. The BUILD routine opens the 
intermediate file created by the first phase and sets up the 


core image of the pseudo machine. Control transfers to the 
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INTRDR routine (Interpreter Reader) which reads the third 
module CINTERP into memory. This is the interoreter and once 


loaded control is passed to it and program execution begins. 


tS 





ee omrero-COSOb COM? I LER 


A. GENERAL DESCRIPTION 


mreewreCRO-COBOL compiler is a one pass compiler that 
scans and parses MICRO-COBOL source programs, and generates 
intermediate code (pseudo-instructions) for the interpreter 
(pseudo-machine). The scanner design is similar to most 
other scanner implementations. The parser is an lLALR(1) 
table-driven design, implemented in the PLM&@ prograrming 
language [1@]. The parse tables, as stated before, were 
generated using an algorithm developed at the University of 
Toronto [20]. 

The corpiler reads the source program from a disk file, 
extracts the needed information for the symbol table and 
writes pseudo-vinstructions to an intermediate code file. To 
meeomolish this function, the compiler consists of three 


modules: PART ONE, READEP, and PART TWO. 


Fees! MBOL TAELE 


The symbol table is the key data Structure in the 
Sompaler. information concerning identifiers, files, and 
records specified in the DATA DIVISION of the MICRO-COBOL 
source program is stored in the symbol table, along with 
labels specified in the PROCEDURE DIVISION. 


Mneesymbpol table structure consists of: 1.) a sixty-four 
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address hash table, 2.) a fixed length field of fourteen 
bytes for each symbol table entry, and 3.) a variable length 
jmeerad tO hold the name of e@ach identifier. Since each 
Mmiemtrrier nare is limited to fifteen ASCII characters the 
Sempot tadvle entry for identifiers can vary in lereth from 
fourteen to twenty-nine bytes. The bytes of each symbol 
table entry are grouped into various fields of either one or 
two bytes depending on the storage requirements. The 
fourteen bytes of the fixed length field entry are numbered 
meom zero to thirteen and the variable length field begirs 
with byte fourteen. In referencing a specific field a byte 
i@ereswith a value from zero to fourteen is utilized. 

meee symbol table entry fora single identifier could 
@oatain up to nine different attributes of that identifier, 
although not all identifiers required the full range of 
attributes. The various fields in tne symbol table contained 
feeerent information depending on whether, for example, ar 
Mmaeemeifier was a numeric or alphanumeric type. Four of the 
meoras COntained the same information for all identifiers. 
These fields were: 1.) field zero (dytes zero and one ) 
contained the collision link, 2.) field one (dyte two) 
contained the type of the identifier, 3.) field two (byte 
three) contained the length of the identifier name, and 4.) 
field thirteen (byte fourteen) was the beginning of the 
ASCII character representation for the identifier name. It 


should be noted that an identifier of type FILLER would not 


ic 





have a name associated with it, so field two would cozxntain a 
mero and field fourteen would not exist. 

Entry into the symbol table is accomplished by using a 
HASF function on the ASCII character representation of tne 
identifier name. This functicn generates an even number 
between zero and 126. The number is used as an index into 
the hash table by specifying an offset from the base of the 
hash table. The hash tabdle can hold sixty-four uniaquely 
determined address references to identifiers. The hash table 
entry associated with each index reference heads a linked 
list of identifiers with the same BASE function value. The 
linked list structure provides for additional identifier 
storage and therefore the number of unique idantifiers is 
not limited by the sixty-four index values generated by the 
HASH function. A zero entry in the hash table indicates that 
Mere. iS no identifier with that HASH function value. In 
meeterne through the linked list of identifiers the most 
recently declared variable appears at the end of the list. 
See figure [II-1] for an example of the computation of a 
hash value. See figure [II-2] for an example of the hash 


table indexing and linking of hash values. 
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HASH VALUE COMPUTATION 


Beer unction value: sum of identifier ASCII characters 


logically and with SFE then shifted left (SEL) one dit. 


HASHBASE = 28025 
H.F.(AB) = BASBHBASE + SHL(((41H + 42H) AND 3FH),1) = 2@@68 
H.©.(BA) = HASHBASE + SHL(((42H + 41H) AND 3FH).1) = 20068 
FIGURE II-1 
PASH TABLE, SYMBOL TABLE LINXING 
HASH SYMBOL 
TABLE TABLE 
aa = Sas aa aoa ! 
| collision! 
1 a a eeer ein ent Or oa’ 
! 1 "BA 
1 ——————! 21244 ta ' 22004 | 
as wea ax = | 
. - 7 = 
j 
= a sx _ | 
! 
= = - - 
ee | 2208H aaa | | 
Phe a === i Cel aS 0m 
ea | 20068 ii cme, | 
a - | “AB 
— a a Soe CILFSOY 
| ---—-—-—-—— | 20088 


FIGURE II-2 
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1. Numeric Values 


The symbol table entry for numeric values can 

Soutain up to eight attributes of the variable. These 
attributes are: 1.) identifier type, 2.) length of variable 
name 3.) veginning address of variable storage, 4.) numeric 
count (number of storage locations required by the 
identifier), 5&.) levsl number, 6.) number of digits to the 
right of the decimal point, 7.) the variable name, and &.) a 
previous occurs pointer. The previous occurs pointer is 
appended after the identifier name only if needed. Since 
mest declarations will not require the use of this pointer, 
a saving of three bytes per variable declaration is 
realized. It was felt that the increase in the total number 
of variables that could be declared in a given memory size 
outweighed the increased complexity in symbol table access 
time. Figures [II-3] and [II-4] illustrate, respectively, 
the following two COBOL declarations: 

@1 NUM PIC 9(9). 

62 NUM PIC 9(6)¥999 OCCURS 12. 


2. Numeric Edit 


The numeric edit symbol table entry expands on the 
numeric symbol entry and utilizes bytes eight and nine to 
hold the beginning address, in tne constants area, of the 


edit field mask. This mask allowed for the insertion of the 
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following characters into the output display of a4 numeric 
number: fixed and floating dollar signs, credit(CR) ard 
debit(DB) signs, asterisk fill, -2 character fill, and plus 
("+ ) and minus ("-') signs. It should be noted that an 
ieentifier with a numeric edit field value cen not be used 
in an arithmetic statement. Figure [II-5] illustrates the 
following COBOL declaration: 


GIMNMMe PIC +S222,57229 99. 
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NUMERIC SYMBOL TABLE ENTRY. 


(4E 55 4D) 


Bile SYMBOL TABL® VALUE 
ee ee ee ee 
g-1 | collision link 
! (28 @@) 
} 
ee —_ 
2 | type identifier 
! (12) 
se mn a a oS 
s | length of identifier 
' name (@3) 
} 
Com Aa sak pee an mg a a 
| beginning address 
4=5 ' of identifier 
' storage (04 25) 
ee ye see ae jp eS 
{ 
6-7 {| length of identifier 
! storage (89 0@) 
eee = te ES a Ss 2 
} 

8-9 ' not used 
a 5 ee Se 
12 level entry (@1) 
ee: 2K 2) he 
io | decimal count (20) 

Spee reas it (ee ee 
{ 
12-13 |! occurances (22) 
} 
ene Sd ee 
14-16 | identifier name 
{ 
| 
{ 


1 NUM PIC 9(9). 
FIGURE II-2 
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NUMERIC SYMBOL 


AND 


2 OP oe ee ee ee ies eo ee oe ee ne oe ee ee ae ee eee ee ee ee ees ee es eee ee oe ee Oe ee ee ee oe ee 


TABLE ENTRY WITH DECIMAL 
OCCURS CLAUSE 


SYMBOL TABLE VALUE 


eollision Link 
(gS 2B) 


type identifier 
(12) 


beneth.or identifier 
name (@3) 


beginning address 
Oppteentititer stor— 
age (@D 25) 


length of identifier 
storage (89 9G) 


identifier name 
(4% 55 4D) 
previous occurs 
pointer 92 @@ 


dimension counter 


92 NUM PIC 9(6)V999 OCCURS 12. 


FIGURE I1-4 
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NUMERIC SYMBOL TABLE ENTRY WITH EDITED FIELD 


BYTE SYMBOL TABLE VALUE 


(4E 55 4D) 


} 
! 
1 
1 
I 
t 
2 | type identifier 
(86) 
= aap EE a eo GS a a GE t mae Sear SSS Ss a Soe 2 Pa ] 2 2 Sa Sa =a 
e ' length of identifier 
| name (92) 
eee sets a 
| beginning address 
4-5 | of identifier stor- 
' age (@D 25) 
= fe i en eee 
k 
6-7 | length of identifier 
| Storage (239 20) 
ge eo a 
| beginning address 
8-9 ! of mask storage 
| (25 FE) 
ee ee (= 
12 | level entry (01) 
plated Re) jee Ma Gece Oe a ae 
j 
el | decimal count (@2) 
{ 
eam Gan = em Gn a= Gc } = eae So Eee ae aS 2 SSS Se SP a aw 42 aa £2 SP a 
12-123 | occurances (@@) 
4 ee 
14-16 |} identifier name 
} 
i 
i 
t 


| 
| 
! 
: 
! 
1 
1 


01 NUM PIC +$222,229.99. 
EICURE Ti=s 
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5. Alpha or Alphanumeric 


The alpha and alphanumeric symbol table ertries 
appear similarly in the symbol table except for their type 
fields. Six entries appear in the symbol table for these 
identifiers: 1.) identifier type, 2.) length of identifier 
name, 3.) beginning address of storage, 4.) number of 
storage locations required by the identifier, 5.) level 
entry, and 6.) identifier name. Figure [II-6] illustrates an 
alpha symbol table entry for the following identifier 
declaration: 


G1 ALPHA PIC A(8). 
4. Alpha Edit 


The alpha edit symbol table entry expands on the 
alpha and alphanumeric edit types and utilizes bytes eight 
and nine to hold the beginning address of the edit field 
mask. These mask fields, which are stored in the cornstarts 
area of the pseudo-machine, contain the characters necessary 
to edit an output so that, for example, slashes or blanks 


can be interspersed in the display output. 
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ALPHA SYMBOL TABLE ENTRY 


(49840 50 426547) 


pads SYMBOL TABLE VALUE 
_ jp 8 ge 
| 
Q-1 pecorpiSion lirk 
' (82 83) 
Bf MOE aoe iene ere ee 
t 
2 | type idertifier 
! (28 ) 
A ee a ee 
a ' length of identifier 
+ (95) - 
ee a ce a a el Na ce ee ee 
t 
| vpeginning address 
4<5 ' of identifier 
storage (16 25) 
eee Lon eee pee = Mee cca ee 
6-7 | length of identifier 
! storage (88 @2) 
2. (ee ee 
e-9 ' not used 
ee ee a ee ae ees eae eas a pm eas Saat GL a eet ee 
t 
1é | level ertry (@1) 
t 
—S PD eS GP a a a > ap f = Sa A aS SS ee oe eee ee ee Se eee oe 
fer | not used 
38 
12-13 }{} not used 
ee ae ee a ae a a ay le es ees ec ta aa en ee a 
t 
13-17 {| identifier name 
t 
: 
l 


91 ALPHA PIC A(8). 
FIGURE II-6 
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5. Tables 


NPS MICRO-COBOL supports multiply indexed tables uv to a 
maximum of ten levels. The choice of ten levels was based on 
a compromise between a single level of HYPO-COBOL and 49 
levels proposed for the new 1980 ANSI COBOL standard. The 
limit of ten levels is a restriction for HYPO-COBOL and the 
nucleus level i constructs of ANSI-COBOL. These tables are 
established by using an OCCURS clause with the PIC clause of 
an identifier. If an identifier is specified as a table the 
number of occurances of the table are placed in byte twelve 
and thirteen of the symbol table entry for that identifier. 
The table identifier in COBOL is similar to the subscripted 
variable in other programming languages. The previous occurs 
pointer shown in FIGURE [I-4 is used to indicate where 
variables are located and how many occurances exist to 
enable the compiler to generate the proper base address. For 
example, the statement, 02 NUM PIC 9(9) occuURS 12, 
generates the symbol table entry illustrated in figure 


(II-4]. 
6. Labels 


Labels generate the simplest of all symbol table 
emaries, Only four or five attributes are associated with 
the label. The variability depends on whether the label is 


declared in the source program before or after tne label is 
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referenced by a GO or PERFORM statement. In the event that a 
label 1s specified bvefore a CO or PERFORM statement 
references it, the symbol table would contain the following 
i.) the type associated with label, 2.) the length of the 
identifier name, 3.) the address of the first intermediate 
code instruction following the appearance of the label in 
the source program (bytes four and five), 4.) the last 
executable instruction associated with the label (bytes 
eight and nine) (This would be either the last executable 
instruction encountered before another label or the end of 
the program), and 5.) the label name. 

In the event a label is referenced by a GQ or 
PERFORM statement before the label actually appears in the 
code, the symbol table entry performs a different function 
than just indicating the beginning and ending of the 
paragraph associated with the label. The same symbol table 
fields are used, however their rmreanings are different. The 
type is set to that of an unresolved label(@FFH). The label 
remains unresolved until the beginning and the ending 
addresses of the associated paragraph are determined. If a 
label is never resolved by the end the input file, an error 
for each unresolved label is produced as a@ warning to the 
user. 

When a label is referenced for the first time by a 
GO statement the symbol table is initialized with the 


following: 1.) unresolved label type (@FFH), 2.) the address 
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of the GO statement (the intermediate code would be BRN 900 
9G where the zeros indicate where the address of the label 
Mmemeto ve Ddackstuffed. See section I1I-D for specific 
explanation of pseudo-machine instructions), c=) the 
remainder of the label entries would be the Same except no 
entry is made for the last executable instruction associated 
meen tne label. If an additional reference is made to the 
label by 2 subsequent GO statement the following action 
would occur: 1.) the current address (bytes four and five) 
would be placed in the branch address of the GO statement, 
2.) the address of this branch statement would be placed in 
bytes four and five of the symbol tadle entry. This 
meocecure facilitates linking together all unresolved 
references to labels so as a result when the label is 
mesolved the correct branch address can easily be placed 
mero the intermediate code. 

Encountering a PERFORM statement before a label is 
declared causes the following actions: 1.) Bytes four and 
five contain the address of the next byte of intermediate 
code following the PER intermediate code instruction, and 
2.) bytes eight and nine contain the address of the third 
byte following the PER instruction. If a subseauent PERFORM 
Statement is encountered before the label is resolved the 
two address fields in the symbol table would be copied to 
the associated bytes following the most current PERFORM 


statement and the address of the first and third bytes 
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Pollowing the PER instruction would be copied into the 
symbol table. It should be pointed out that any number of 
PERFORM and GO statements can be specified before a label is 


resolved. 
7. Files 


The symbol table entries for files are the most 
difficult to understand. The complexity of the entries is 
due to the way files and records are declared in a 
MICRO-COROL program. The symbol table entry for ae file 
consists of the following: 1.) byte two contains the type, 
2.) byte three contains the length of the file name, 3.) 
bytes four and five contain the address in the symbol table 
of the first @1 level record associated with the file, 4.) 
bytes eight and nine contain the beginning address of the 
file control block and input/output buffer for the file, 
(this would be the actual address in the data section of the 
pseudo-machine for the beginning of the 165 bytes associated 
with the file), 5.) if tne file has a key entry associated 
with it (access via RANDOM or RANDOM RELATIVE) bytes ten and 
eleven contain the symbol table address of the access key 
variable, and 6.) the rest of the entry contains the file 
name. Figure [(II-6] illustrates a file entry in the symbol 


table. 


8. Records 
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ico meehLrymcOnvains Seven attributes of a record. 
Three are the same as all other entries type, name, and 
length of name. While the other four are: 1.) bytes four and 
five contain the initial storage address for the record, 2.) 
bytes six and seven contain the number of bytes of storage 
for the record, 3.) bytes eight and nine contain the symbol 
table address of the file associated with the record (this 
facilitates referencing the file when tne record is 
written), and 4.) byte ten contains the level entry for the 


record. 
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FILE SYMBOL TAELE ENTRY 


SAMPLE SOURCE PROGRAM FILE DECLARATION 


INPUT-OUTPUT SECTION. 
FILE-CONTROL. 
SELECT ROSTER-FIL 


ree 


14-18 


= ae = oe 8 Oe ee ew Se Se oe ew SE ee ew ee 2 Ce ew SE eS 2 ee eS Ss ew SO we we SE ee oe Oe ew ee ow Oe ES 2 2 ee ee ee ee ee Se os ow SS SO Se ee ee C2 ee ee = ee 


ORGANIZATION RELATIVE 
ACCESS RANDOM RELATIVE NUM 
ASSIGN CS61-FIL. 


SYMBOL TABLE VALUE 


type file 

(03) 

length of file 
name (95) 

symbol table 
address of first 
91 level record 
(@G 22) 


first address of 
FCB & buffer 
(GE 26) 


symbol table 
address of key 
(25227) 


not used 


eau @EP aw a @P a= ee @ @P =e GP amp ap 22 aw ap a= 


file name 
(52 4F 53 54 45 52 
5F 46 49 4C) 
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C. COMPILER MODULE “PART ONE’ 


ie Purpose 


Maye first module of the compiler performs several 
functions. First, it establishes the interface between the 
compiler and: 1.) the input source file (of type CBL ), 2.) 
the output intermediate code file (of type CIN), 3.) the 
output list file (of type LST ), and 4.) the READER module 
which reads and passes control to PART TWO of the compiler. 
Second, it scans and parses the Source program statements up 
to the PROCEDURE DIVISION. Third, it generates output 
consisting of the symbol table entries (saved in memory) and 
data initialization intermediat2= code. A listing file is 
also created which will contain any compilation errors 
generated and a listing of the source code ro the 
appropriate toggle is activated. See Appendix A fora list 


of compiler options. 
eee Control Actions 


By executing the command COBOL <source program> 
$<compiler toggles> the object code for PART ONE of the 
compiler is loaded into memory starting at 1004 (tee 
necessary this can be modified for different machines) by 
the CP/M operating system. Execution of PART ONE loads the 
source program name into the input file control block 


located at SCH. This allows the source program name to de 
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saved until actual source program comoilation begins. The 
compiler toggles are loaded into the inout file control 
block located at 6CH. These ovtional toggles are used later 
to initialize certain features Such as code, nocode, list, 
momrst, @€tc. See Appendix A for a complete list of options. 
Next, the control program, READER, is moved to high 
memory just below the BDOS (see reference 4 for an 
explanation of BDOS and other CP/M associated names). For 
example, using an INTEL Corporation 62K MDS microcomputer 
system with the CP/M operating system, the READER routine is 
moved to high memory starting at ODO@@G@E and continuing 
through @D@FFE. This is done for two reasons: 1.) it allows 
the symbdol table of the source program to begin et the next 
address following the object code for PART ONE, and 2.) 
places RSADER high enough in memory so that it is not 
destroyed by creation of the Symbol table. See figures 
{II-7] and [II-8] for illustrations of the PART ONE memory 
organization before and after the READER routine is moved. 
The purpose of the READER routine will be exvlained in the 


next section. 
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MEMORY ORGANIZATION BEFORE READER ROUTINE MOVED 
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MEMORY ORGANIZATION AFTER READER ROUTINE MOVFD 
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FIGURE I1-8 
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Next, the interface between the compiler and the input 
file <source program> and the output file <intermediate code 
file> is established. The input file control block 
associated with the source file is initialized and the input 
file is opened. The input file name is copied to the output 
file control block (FCB) and if there is an intermediate 
code file already residing on the disk, it is erased. The 
mmeput FCR is initialized and a file directory entry 
established for the new copy of the intermediate code file. 
A list file control block and associated buffer are created 
and opened. The list file contains any error messages 
generated by the compiler and the line bveing parsed at the 
time the error was discovered. The relative line number is 
also provided. With the list toggle activated the list file 
will contain the complete input file with errors eénd line 
numbers. 

Prior to beginning scanning and parsing actions, the 
first 128 byte record of the input file is read into the 
input buffer, located at SOH (default I/O buffer for CP/M). 
The scanner is primed with the first character of the input 
program, and scanning and parsing actions continue from this 
point in PART ONE until the PROCEDURE DIVISION of the source 
program 1s encountered; at this time compilation is 


suspended. 


5S. Symbol Table Entries 
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Entries made in the symbol table by PART ONE will 
consist of all identifiers declared in the DATA DIVISION of 
the Peuree program. By refering to the Symbol Table Section 
above, an explanation may be obtained regarding the various 


tyves of symbol table entriss. 


4. Intermediate Code Generation 


Pseudo-instructions are written to the intermediate code 
file for several different reasons while PART ONE is 
scanning and parsing tnewsoOUrcCe program. The first 
intermediate code generated occurs when the INPUT-OUTPUT 
SECTION of a source program is nonempty. Within the FILE 
CONTROL PARAGRAPH of this section, instructions are 
generated to initialize the FCB for the file name associated 
with the SELECT statement. The name associated with the 
ASSIGN statement is placed in the FCB and is used in 
referencing the file on the disk. 

Two other instances of intermediate code generation 
occur in the WORKING STORAGE SECTION of a source program. 
Anytime a record or elementary identifier entry has an 
edited PICTURE CLAUSE, code to initialize the storage 
beginning at the address specified in the formatted mask 
attribute of the symbol table ertry will be written to the 
intermediate code file. When a record or elementary 


identifier entry has an associated numeric or nornumeric 
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VALUE CLAUSE, code to initialize the storage beginning at 
the address specified in the value location attribute of the 
symbol table entry will be written to the intermediate code 
fle. 

The final pseudo-instruction written to the intermediate 
code file is the SCD instruction. This occurs when the 
parser parses the word PROCEDURE in the source program; 
sontrol 1s then passed to PART TWO and compilation 


continues. 
S. Parser Actions 


The actions corresponding to each parse step are 
explained below. In each case, the grammar rule that is 
being applied is given, and an explanation of what program 
actions take place for that step has been included. In 
describing the actions taxen for each parse step there has 
been no attempt to describe how the symbol table is 
constructed, what pseudo-instructions are generated or now 
the values are preserved on the stack. The intent of this 
section is to describe what information needs to be retained 
and at what point in the parse it can be determined. Where 
no action is required for a given statement, or where the 
Only action is to save the contents of the top of the stack, 
no explanation is given. Questions regarding the actual 
Manipulation of information should be resolved by consulting 


the program listings. 
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1d 


ne 


135 


14 


a 


16 


AC 


18 
19 


<program> ::= <id-div> <e-div> <d-div> PROCEDURE 
Reading the word PROCEDURE terminates the first 
part of the compiler. 
Cid-div> ::= IDENTIFICATION DIVISION. PROGRAM-ID. 
<comment> . <id-list> 
mlazList> ::= <auth> <ins> <date>d <secd> 
<auth> ::= AUTHOR . <comment> . 
| <empty> 
<ins> ::= INSTALLATION . <comment> 
1 <empty> 
<date> ::= DATE-WRITTEN . <comment> 
| <empty> 
<sec> ::= SECURITY . <comment> 
| <empty> 
<comment> ::= <input> 
| <comment> <input> 
<e-div> ::= ENVIRONMENT DIVISION . CONFIGURATION 
SECTION. <srce-obj> <i-o> 
| <empty> 


<erc-O0j> 2: 


SOURCE-COMPUTER . <comment> <debug> 
OBJECT-COMPUTER . <comment> 
<debug> ::= DEBUGGING MODE 
set a scanner toggle so that debug lines will be 
mead . 


1 <empty> 
<i-o> ::= INPUT-OUTPUT SECTION . FILE-CONTROL . 
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<file-control-list> <ic> 
| <empty> 
<file-control-list> ::= <file-control-entry> 
| <tile=control-list> 
Stahemce Otseo elk Ty 
Saae=control—entry> ::= SELECT <id> <attribute-lList> . 
At this point all of the information about the file 
has been collected and the type of the file can be 
Parone c mmc atti riputes are checked for 
compatibility and entered in the symbol table. 
Cattribute-list> ::= <one attrib> 
| <attribute-list> <one attribd> 
<one-attrib> ::= ORGANIZATION <org-type> 
| ACCESS <acc-type> <relative> 
| ASSIGN <input> 
A Pile COmuUpOLMNuOCt eS DUlIt for the file using the 
INT operator. 
<org-type> 3::= SFQUENTIAL 
No information needs to be stored since the default 
file organization is sequential. 
| RELATIVE 
The relative attribute is saved for production 23. 
| INDEXED 
The indexed attribute is not implemented. 
<ace~type> ::= SEQUENTIAL 


This is the default. 
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28 


22 


55 
56 
Ov 
08 
359 
49 
41 
42 
435 


44 


2° 


46 


47 


| RANDOM 
The random access mode is saved for production 19. 
<relative> ::= RELATIVE <id> 
The pointer to the identifier will be retained by 
the current symbol pointer, so this production only 
saves a flag on the value stack indicating that the 
proauetion did occur. 
| <empty> 
rcp :2= I-O-CONTROL < <same-list> 
' <empty> 
<same-list> ::= <same-element> 
| <same-list> <same-element> 
<same-element> ::= SAME <id-string> . 
Srd=string> ::= <id> 
| <id-string> <id> 
<d-div> ::= DATA DIVISION . <file-section> <work> 
<link> 
<file-section> ::= FILE SECTION . <file-list> 
A flag needs to be set to indicate completion of 
the file section, so that the appropriate routine 
will be called when parsing level entries in the 
WORKING STORAGE SECTION. 
| <empty> 
The flag, indicated in production 44, is set. 
<file-list> s:= <file-element> 


' <fPile-list> <file-element> 
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meee <files> ::= FD <id> <file-control> . 


<record-descriptior> 
This statement indicates the end of a record 
description, if there was an implied redefinition 
of the record, then the level stack (IDSSTACX) 
must be reduced. The length of the first record 
description and its address can now be loaded 


into the symbol table for the file name. 


49 <file-control> ::= <file-list> 


98 


om 
3 
935 
04 


he) 
JO 
ot 


The address of the symbol table entry for the 
record describding the file name is entered into an 
attribute of the file name symbol table entry, 
while the address of the file name’s Symbol table 
entry is entered into an attribute of the same 


record. 


1 <empty> 


Same as 49 above. 


<file-list> ::= <file-element> 


, <file-list> <file-element> 


<file-element> ::= BLOCK <integer> RECORDS 


| RECORD <rec-count> 
The record length is saved for comparison with 
the calculated length from the picture clauses. 
| LABEL RECORDS STANDARD 
| LABEL RECORDS OMITTED 
| VALUE OF <id-string> 
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99 


62 


61 
62 
63 
64 
Sh 
66 


<rec-count> ::= <integer> 
' <integer> TO <integer> 
The TO option is the only indication that the file 
will be variable length. The maximum length must be 
saved. 
<work> ::= WORKING-STORAGE SECTION . <record-description> 
If the level stack (IDSSTACK) contains a record 
identifier with a level number greater than one, 
then the stack must be reduced. The reduction 
depends on whether the identifier on the ton of 
the stack is a redefinition of the item beneath 
it or not. The primary action iS to assign the 
proper amount of Storage to the last record in 
the WORKING STORAGE SECTION. 
| <empty> 
Clink> ::= LINKAGE SECTION . <record-description>d 
| <empty> | 
<record-description> ::= <level-entry> 
‘<record-description> <level-ertry> 
<level-entry> ::= <integer> <data-id> <redefines> 
<data-type> . 
The symbol table address for the level entry 
identifier is loaded into the level stack 
(IDSSTACK). The level stack keeps track of the 
nesting of field definitions (elementary items) 


in a record in the FILE and WORKING STORAGE 
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SECTIONS. At this point there may be no infor- 
mation about the length of the item being defined 
and its attributes may devend entirely upon its 
constituent fields. Within the FILE SECTION, 
multiple record descriptions for a file are 
assumed to be redefinitions of the first record 
description. In the WORKING STORAGE SECTION, if 
there is a VALUE CLAUSE, the stack level to which 
it applies is saved in PENDINGSLITERAL, the level 
entry number is saved in VALUESLEVEL and a flag, 


VALUESFLAG, is set. 


67 <data-id> ::= <id> 


68 


| FILLER 
An entry is built in the symbol table to record 
information about this record field. It cannot be 
used explicitly in a program because it haS no name, 
but its attributes will need to be stored as part of 


the total record. 


69 <redefines> ::= REDEFINES <id> 


The redefines option gives new attributes to a 
previously defined record area. The Symbol table 
pointer to the area being redefined is saved in an 
attribute of the redefining identifier’s symbol table 
entry, so that information can be transferred to tke 
area by either identifier. In addition to the inform- 


ation saved relative to the redefinition, it is nec- 
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78 


71 
we 
73 
74 
HOO 


essary to check to see if the current identifiers 
level number is less than or equal to the level number 
of the identifier currently on the top of the level 
stack. If this is true, then all information for the 
item on top of the stack has been saved and the stack 
Can be reduced. If the current identifier is a redef- 
inition of another identifier, the stack entry for the 
record being redefined is not removed until the first 
non-redefinition of a current identifier at the same 
level. 

| <empty> 
As in production 64, the stack (ID$STACK) is checked 
to determine if the current level number indicates a 
reduction of the level stack is necessary. In add- 
ition, special action needs to de taken if the new 
level is @1. If an 01 level is encountered at this 
production prior to production 39 or 48 (the end of 
the file area), it is an implied redefinition of the 
previous @1 level record. In the WORKING STORAGE 


SECTION, it indicates the start of a new record. 


<data-type> ::= <prop-list> 


| <empty> 


<prop-list> ::= <data-element> 


i <prop-list> <data-element> 


<data-element> ::= PIC <input> 


The <input> at this point is the character string 
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76 


we 


78 


79 


88 


81 


Paatecerines the record field. It is analyzed and the 
necessary extracted information is stored in the 
symbol table. 

| USAGE COMP 
The field is defined as a binary field; however, 
COMP has not been implemented, therefore, if 
there is an associated VALUE CLAUSE, the value is 
entered into the associated identifier’s value 
storage location in display format. 

| USAGE COMP-3 
The field is defined as a packed Binary Coded Decimal 
field. 

| USAGE COMPUTATIONAL 
Optional form of USAGE COMP. 

| USAGE DISPLAY 
The DISPLAY format is the default, and thus no 
special action occurs. 

| SIGN LEADING <separate> 
This production indicates the presence of a sign in 
a numeric field. The sign will be in a leading 
position. If the <separate> indicator is true, 
then the length will be one longer than the PICTURE 
CLAUSE, and the type will be changed to signed 
numeric leading and separate. 

| SIGN TRAILING <separate> 


The same information required by production 73 must 
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be recorded, but in this case the sign is trailing 
rather than leading. 

82—C, ' OCCURS <integer> INDEXED <id> 

83 | OCCURS <integer> 
The type must be set to indicate multiple 
occurrences and the number of occurrences saved 
for computing the space defined by this field. 

84 , SYNC <direction> 
Syncronization with a natural boundary is not 
required by this machine. 

85 | VALUE <literal> 
The field being defined will be assigned an initial 
value determined by the value of the literal through 
the use of an INT operator. This is only valid in 
the WORKING-STORAGE SECTION. Note that numeric and 
Signed numeric PICTURE CLAUSES will have a numeric 
-—- no quotes delimitirg -- VALUE CLAUSE, while 
alphanumeric and alpha tyves will have a nonnumeric 
== literal delimited with quotes ~-- VALUE CLAUSE. 

86 <direction> ::= LEFT 

87 | RIGHT 

88 | <empty> 

89 <Separate> ::= SEPARATE 
The separate sign indicator is set. 

92 | <empty> 

St <literal> ::= <input> 
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92 


93 


94 
95 
96 


97 


D. 


Dee input string is checked to see if it is a valid 
mumerie iteral, an@ if valid, it iS stored to be 
used in a value assignment. 

eli t> 
This literal is a quoted string. 

| ZERO 
As the case of all literals, tne fact that there 
is a pending literal needs to be saved. In this 
case and the three following cases, an indicator 
of which literal constant is being saved is 
all that is required. The literal value can be 
meconstructed Later. 

| SPACE 

| QUOTE 


<integer> r2= <input> 


The input string is converted to an integer value 


for later internal use. 


<id> ::= <input>d 


The input string is the name of an identifier and 
1s checked aginst the symbol table. If it is in the 
Symbol table, then a pointer to the entry is saved. 
If it is not in the symbol table, then it is 


entered and the address of the entry is saved. 


INTERFACE ACTIONS 
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When compilation is suspended in PART ONE of the 
compiler certain key variables are saved for use in PART 
TWO. These variables are declared sequentially in PART ONE 
and are therefore located in contiguous memory in the 
variable area of PART ONE. These variables consist of 
debugging toggles set when invoking the compiler, i.e. 
sequence or token numbers, a pointer to the next available 
address in the symbol table, a pointer to the next character 
in the input source file, the outout and list file control 
blocks, the output and list buffers, the error counter, the 
next address in the intermediate code area, the next address 
in the constants area, and the base address of the symbol 
table. These key variables, consisting of 353 bytes, are 
copied to the 353 bytes immediately below the READER routine 
to insure they are not destroyed when PART TWO of the 
compiler is brought into memory. Since the memory area 
required for PART ONE is larger than that required by PART 
TWO the symbol table does not need to be relocated. Since 
the symbol table is not altered when PART TWO of the 
compiler is brought into memory only the base address of the 
symbol table and the last address of the symbol table need 
be saved to insure that access to the symbol table can be 
continued in PART Two. See Figure [11-10] for an 
Lllustration of the memory organization when control is 
transfered from PART ONE to READER. The READFR routine 


causes PART TWO of the compiler to be >brought into memory 
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starting at 16@H and then transfers control to PART TWO of 


the Compiler. 


E. COMPILER MODULE PART TWO. 


ie euUrpose 


The second part of the compller scans and parses the 
MICRO-COBOL source statements starting with the PROCEDURE 


DIVISION and generates the necessary intermediate code. 
2. Control Actions 


The first action after control is transfered to PART TWO 
from the READFR routine is to copy the 355 bytes of 
information saved from PART ONE into associated variables in 
PART TWO. After these variables are initialized ail 
references to files, symbol table entries, etc. can be made 
in PART TWO and compilation can continue. See Figure [II-1i1] 
for an illustration of the memory organization at the time 


PART TWO begins compilation. 
5S. Symbol Table Entries 


Entries made in the symbol tabdle by PART TWO will ode 
those for paragraph labels encountered within the PROCEDURE 


DIVISION of the source program. 


4. Intermediate Code Generation 


3) 





For an explanation of the pseudo-instructions that are 
generated by PART TWO refer to the compiler program listings 
and the parser actions below. Also, for general information 


on pseudo-instructions refer to section III-D. 
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MEMORY ORGANIZATION WHEN CONTROL IS TRANSFERRED TO READER 
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MEMORY ORGANIZATION AFTER PART TWO IS COPIED INTO MEMORY 
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5. Parser Actions 


The actions corresponding to each parse step in PART TWO 
are explained below. In each case, the grammar action that 
is being applied is given, and an explanation of what 
program actions take place for that step has been included. 
In describing the actions taken for each parse step there 
has been no attempt to describe how the symbol table entries 
are made, what pseudo instructions are generated or how the 
values are preserved on the stack. The intent of this 
section is to describe what information needs to be retained 
and at what point in the parse it can be determined. Where 
no action is required for a given statement, or where the 
Only action is to Save the contents of the top of the steck, 
no explanation is given. 

1 <p-div> ::= PROCEDURE DIVISION <using> . 
“oroc-pody> hON 
This production indicates termination of the 
compilation. If the program has séctions, then 
it will be necessary to terminate the last section 
with a RET @ instruction. The code will be ended 
by the output of a TER operation. 
2 <using> ::= USING <id-string> 
If the reserved word CALL is on the procedure stack then 
the PAR operator is produced followed by the addresses 


of the parameters that will be passed from the calling 
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program. If the reserved words PROCECEDURE DIVISION are 
on the procedure stack then the identifier stack contains 
the formal parameters that will be used for that procedure. 
These variables are given sequential address locations 
Starting at @DH so that the addresses may be resolved at run 
time by getting the actual parameter address off the call 
stack. 
PAR <number of parameters> <varameter #1 address> ... 

3 | <empty> 

4 <id-string> ::= <id>D 
The identifier stack is cleared and the symbol 
table address of the identifier is loaded into 
tie wr 'rst stack Location. 

S i <id-string> <id> 
The identifier stack is incremented and the symbol 
table pointer stacked. 

6 <proc-bdody> ::= <paragraph> 

? {| <proc-body> <paragraph> 

Sees Daragraph> ::= <id> . 

9 i <id> . <sentence-list> 
The starting and ending address of the paragraph 
are entered into the symbol table. <A return is 
emitted as the last instruction in tne paragracth 
(RET @). When the label is resolved, it may be 
necessary to produce a BST operation to resolve 


previous references to the label. 
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10 


4 
12 
135 
14 


Le) 


LO 


ee 


18 


19 


22 
aa} 


(ecco mone TVON . 
The starting address for the section is saved. If 
it is not the first, then the previous 
section ending address is loaded and a2 return 
(RET @) is output. As in production 9, a BST may 
be produced. 
<sentence-list> ::= <sentence> . 
i; <sentence-list> <sentence> . 
<sentence> ::= <imperative> 
| <conditional> 
| ENTER <id> <opt-id> 
This construct is not implemented. An ENTER allows 
statements from another language to inserted in the 
source code. 
<imperative> ::= ACCEPT <subid> 
ACC <address> <length> 
: <arithmetic> 
; CALL <call-lit> <using> 
The SBR operator is produced. 
SBR <subroutine name> 
| CLOSE <close-lst> 
CLS <file control block address> 
| <file-act> 
| DISPLAY <display-lst> 
The display operator is produced for the first 


literal or identifier. 


sit 





me 


25 


24 


ZO 


26 


27? 
28 


DIS <address> <length> <flag> 
| DISPLAY <display-lst> WITH NO 
ADVANCING 
The DISPLAY WITH NO ADVANCING option is not implemented. 
| EXIT <program~-id> 
RET @ 
| GO <id> 
BRN <address> 
| GO <id-string> DEPENDING <id> 
GDP is output, followed by a number of parameters: 
<the number of entries in the identifier stack> 
<the length of the depending identifier> <the 
address of the depending identifier>d <the address 
Seeedcn identitier in the stack>. 
7 MOVS <lit/id> TO <subid> 
The types of the two fields determine the move that 
is generated. | Numeric moves go through register two 
using a load and a store. Non-numeric moves depend 
upon the resultant field and may be either MOV, MED or 
MNE. Since all of these instructions have long 
parameter lists, they have rot been listed in 
detail. 
| OPEN <act~-lst> 
| PERFORM <id> <thrud <finish> 
The PER operation is generated followed by the 


<branch address> <the address of the return 
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eo 


58 
o1 


52 
O8 


54 


55 


oO? 


38 


o9 


40 


41 


42 


statement to be set> and <the next instruction 


address>. 


' STOP <terminate> 


If there is a terminate message, then STI is 


produced followed by <message address> <message 


length>. Otherwise STP is emitted. 


<close-lst> 3::= <id> 


<close-lst> <id> 


Multiple close option is not implemented. 


Sarsplay-1lst> ::= <t/id> 


| <display-lst> <lit/id> 


Multiple display option is not implemented. 


<act-1st> ::= <type-action> <open-lst> 


This produces either OPN, OP1, or OP2 denendinreg 


upon the <type-action>. Each of these is followed 


By file control blocs address. 


i <act-lst> <type-action> <open-lst> 


<open-lst> ::= 


<a 


<open-lst> <id> 


Multiple open option is not implemented. 


<finish> s:= <l/id> TIMES 


This produces the code to perform a paragraph <l1/id> TIMSS. 


| <stopcondition> 


| <varying> <iteration> <stopcondition> 


<stopcondition> 


i <empty> 


UNTIL <condition> 


a2 


43 
44 


45 


46 


47 


48 


49 


52 


1 


<varying> ::= VARYING <subid> 
<iteration> ::= <from> <by> 
<from> ::= FROM <l/id> 
The counter is initialized to <l/id>. 
<opy> 3::= BY <1/id>d 
The counter is incremented BY <l/id>. 
<conditional> ::= <arithmeticd <size-error> <imperative> 
A BST operator is output to complete the branch around 
the imperative from production 117. 
| <file-act> <invalid> <imperative 
A BST operator is output to complete the branch from 
mroauction L116. 
' <read-id> <svecial> <imperative> 
A BST is produced to complete the branch arourd the 
<imperative>. 
| <if-nonterminal> <condition> 
Sii-rst? Serse> <ir-tst> END=IF 
NEG will be emitted unless <condition> is a 
"NOT <cond-type> , in which case the two negatives 
will cancel each other. Two BST operators are required. 
meme first fills in the branch to the ELSE action. The 
second completes the branch around the <if-lst> 
Which follows FLSE. 
| <if-nonterminal> <conditior> 


Gia S tpn Dlr 


52 <iferlst> ::= <stmt-lst> 


60 





55 


| NEXT SENTENCE 
A branch operator is produced to branch to the end of 


the current sentence. 


54 <else> ::= ELSE 


55 <Arithmetic> ::= ADD <add-lst> TO <subid> <round>D 


96 


a7 


The existence of multiple load and store instructions 
make it a@ifficult to indicate exactly what code will 
be generated for any of the arithmetic instructions. 
The type of load and store will depend on the nature 
of the number involved, and in each case the stancard 
parameters will be produced. This parse step will in- 
volve the following actions: first, a load will be 
ermacted for the first number into register zero. If 
there is a second number, then a load into register 
one will be produced for it, followed by an ADD and a 
STI. Next a load into register one will be generated 
for the result number. Then an ADD instruction will 
Dememittved. Finally, if the round indicator 1s set, a 
RND operator will be produced prior to the store. 
| ADD <add-lst> GIVING <subid> <round> 
The ADD GIVING option is not implemented. 
| DIVIDE <l/id> INTO <l/id> <round> 

The first number is loaded into register zero. The 
second operand is loaded into register one. A DIV 
operator is generated, followed by a RND operator 


prior to the store, if required. 
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58 


39 


62 


1 


Gc 


63 


64 


65 
66 


67 
6& 


69 


| DIVIDE <l/id> BY <l/id> GIVING 
<subid> <round> 
The DIVIDE GIVING option is not implemented. 
| DIVIDE <l1/id> INTO <l/id> GIVING 
<subid> <round> 
| MULTIPLY <1/id> BY <subid> <round> 
The multiply is the same as the divide except that a 
MUL operator is generated. 
| MULTIPLY <l/id> BY <1/id> GIVING 
<subid> <round> 
| SUBTRACT <sub-lst> FRCM <subid> 
<round> 
Subtaction generates the same code as the ADD except 
that a SUB is produced in place of the ALD. 
| SUBTRACT <sub-lst> GIVING <subid> 
<round> 
The SUBTRACT GIVING option is not implemented. 
| COMPUTE <subid> = <arith-exp> 


The COMPUTE verb is not implemented. 


€add-lst> ::= <l/id> 


' <add-lst> <l/id> 


Multiple ADD option is not implemented. 


<sub-lst> ::= <l/idd 


1 <sub-lst> <l/id> 


Multiple SUBTRACT option is not implemented. 


<arith-exo> ::= <term> 
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7 
wi 
we 
73 
74 
75 
76 
ae 
78 
79 
82 
81 


82 


&3 


84 


85 
86 


Productions 69 through 88 are required for the COMPUTE 
verb and are not implemented. 
| <arith-exp> + <term> 
| <arith-exp> - <term> 
| + <term> 
i - <term> 
<term> ::= <primary> 
| <term> * <primary> 
i <term> / <primary> 
<primary> ::= <prim-elem> 
| <primary> ** <prim-elem> 
<prim-elem> ::= <l/id> 
| ( <arith-exp> ) 
<file-act> ::= DELETE <id> 
Either a DLS or a DLR will be produced along with the 
required parameters. 
| REWRITE <id> 
Either a RWS or a RWR is emitted, followed by parame- 
ters. 
| WRITE <id> <special-act> 
There are four possible write instructions: WTF, WVL, 
WRS, and WRR. 
<condition> ::= <bdterm> 
The logical OR and AND operators are rot implemented. 
| <condition> OR <bterm> 
<bterm> ::= <bprim> 
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87 
88 
89 


98 
7 
92 
935 
94 


95 
96 
97 
98 
99 


102 
181 
182 
123 


' <pterm> AND <bprim> 
“pprim> s:2= <lit/id> 
' <lit> <not> <cond-type> 
One of the compare instructions is produced. They are 
Se,  oNo, CNU, RGT, RLT, REQ, SCT, SLT, and SEQ. 
Two load instructions and a SUB will also be generated 
if one of the register comparisons is required. 
' ( <bterm> ) 
<cond-type> ::= NUMERIC 
| ALPRABETIC 
| <compare> <lit/id> 
aot> ::= NOT 
NEG is emitted unless the NOT is part of an IF 
Statement in which case the NEG in the IF 


statement is cancelled. 


| <empty> 
<compare> ::= GREATER 
| LESS 
| EQUAL 
| > 


Productions 99-191 are not implemented. 
1 < 


<ROUND> ::= ROUNDED 


i <empty> 


104 <terminate> ::= <literal> 
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195 


| RUN 


196 <special> ::= <invalid> 


107 


An EOR operator is emitted followed by a 


zero 


stuffed with a branch address. 


acts 


| END 
zero. The 
as a filler in the code and will be back- 


In this production 


and several of the following, there is a forward 


branch on 


For an example of the resolution, 


mee <opt-id> :: 


189 


io <stmt-list> :: 


&é false condition past an imp?rative action. 


examine production 48. 


<subid> 
| <empty> 


<imperative> 


111 1 <stmt-lst> <imperative> 
112 | <conditional> 
ip 3 i <stmt-lst> <conditional> 
114 <thrud> ::= THRU <id> 
iL ale | <empty> 
26 «<invealid> ::= INVALID 
INV @ 
ep? <size-error> ::= SIZE ERROR 
SER @ 
118 <special-act> ::= <when> ADVANCING <how-many> 
119 | <empty> 
126 <when> ::= BEFORE 
121 | AFTER 
122 <how-many>::= <integer> 
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bec 
124 
ae) 
126 
het 
eo 


129 


1352 


Bol 


152 
155 
134 


135 
156 


| PAGE 


<type-action> = INPUT 
| OUTPUT 
| I-0 

<subid> = <subscript> 


| <id> 
<integer> ::= <input>d 
The value of the input string is saved as an internal 
number. 
<id> ::= <input> 
The identifier is checked against the symbol table, if 
it is not present, it is entered as an unresolved 
label. 
miyid> ::= <input> 
The input value may de a numeric literal. If so, it 
is placed in the constant area with an INT operator. 
If it is not a numeric literal, then it must be an 
identifier, and it is located in the symbol table. 
| <subscript> 
| ZERO 
<subscript> 3::= <id> ( <subscript-lst> ) 
A SCR operator is produced with the base address cf a 
variable defined with an OCCURS clause. Multiple 
subscripting has not been implemented. 
Csubscript-lst> ::= <input> 


1 <subdscript-lst> , <input> 
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ror 


158 


Poo 
140 
1 


142 


143 
144 
145 
146 
147 


148 


149 


Moar -lit> 2s= <lit> 
The name of the module to be called is saved for use 
mio roduction 18. 
€nn-lit> ::= <lit> 
The literal string is placed into the constant area 
usirg an INT operator. 
| SPACE 
| QUOTE 
<literal> ::= <nn-lit> 
' <input> 
The input value must be a numeric literal to be valid 
and is loaded into the constant area using an INT 
operator. 
| ZERO 
mert/id> ::= <l1/id> 
! <nn-lit> 


<program-id> ::= <id> 
1 <empty> 
<read-id> ::= READ <id> 
There are four read operations: RDF, RVL, RRS, anda 
FE to 


<if-nonterminal>::=IF 
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ITI. NPS MICRO-COBOL INTERPRETER 


A. GENERAL DESCRIPTION 


The following sections describe the NPS MICRO-COBOL 
pseudo-machine in terms of the implementation, memory 
organization, interface actions and interpreter 
instructions. The pseudo-machine, which is constructed in 
the transient program area of CP/M, is the target machine 
for the compiler and is implemented through a programmed 
interpreter. The interpreter decodes each operation and 
either calls subroutines to perform the required actions or 
acts directly on the run time environment to control the 
actions of the interpreter. All communications between 
instructions is done through common areas in the program 
where information can be stored for later use. See figure 
[III-1] for an illustration of the pseudo-mechine 
organization. 

The machine contains a program counter and multiple 
parameter operations which contain all the information 
required to overform one complete action required by the 
language. Three eighteen digit, double length registers are 
used for arithmetic operations, along with a subscript stack 
used to compute subscript locations, a parameter stack to 
resolve the address of actual parameters and a set of flags 


which are used to pass branching information from one 
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instruction to another. 

Addresses in the pseudo-machine are represented by 16 
bit values. Any memory address greater than 2@ hexidecimal 
is valid. Addresses less than 2@ hexidecimal will  bve 
interpreted as having special significance. Yor example 
addresses one through eight are reserved for subscript stack 
references. All other addresses. in the machine are absolute 
eaaresses 

The registers allow manipulation of signed numbers up to 
Cighteen digits in length. Included in their representation 
is a Sign indicator and the position of the assumed decimal 
point for the currently loaded number. Numbers are 
represented in standard COBOL ‘Display or Binary Coded 
Decimal (COMP-3 or BCD) format. These numbers may have 
separate signs indicated by + and —- or may have a zone 
indicator, denoting a negative sign, in the most sigrificant 
byte of a number’s storage location. Before operations occur 
On any number, it is converted to a vacked decimal format 


and entered into one of the pseudo-machine registers. 


B. MEMORY ORGANIZATION 


The memory of the pseudo-machine is divided into three 
Major areas: 1.) the data area is established by the DATA 
DIVISION statements of the source program, 2.) the constants 


area which is established by both the DATA and PROCEDURE 
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MiyisiONS of the source program, and 3.) the code area which 
is established by the PROCEDURE DIVISION. 

The data area is the lowest area in the pseudo-machine. 
This ar@a contains the storage for identifiers declared in 
the DATA DIVISION. Additionally, the data area contains the 
File Control Block (FCB) and the buffer space (128 bytes) 
for all files declared in the source program. 

Immediately following the data area is the code area. 
This contiguous area of storage contains all executable code 
generated. The constants area is located in high memory of 
the pse@udo-machine. This area contains all edit field masks 
as well as all numeric and non-numeric literals. Figure 
[III-1] illustrates the memory organization of tne 


pseudo-machine. 
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PSEUDO-MACHINE ORGANIZATION 
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C. INTERPRETER INTERFACE 


The interpreter consists of Poon ines routines and 
the main interpreter program. To execute the interpreter the 
command EXEC <filename>, (where file type is CIN), is typed 
moeube terminal. fhis action causes the two interface 
routines, RUILD and INTRDR, to be brought into memory. See 
figure [III-2] which illustrates the memory organization 
immediately after BUILD and INTROR have been copied into 
memory. 

The BUILD routine reads in the intermediate code, 
initializes all memory locations requiring initialization, 
and resolves all unresolved address references. In addition 
the BUILD routine loads subroutines into memory. If a SER 
instruction is eEencountered during execution of BUILD, the 
SUBSFLAG is set aS an indicator that subroutines will have 
to be loaded. The name of the subroutine is saved and when 
the TER instruction is Encountered a check of the SUBSFLAG 
is made and if set each subroutine is loaded into memeory. A 
table similar to the compiler’s symbol table is used to 
maintain the names, location, and status (loaded or 
unloaded) of each subroutine. Until a subprogram is loaded 
the actual branch address is not known. The same mechanism 
used for resolving forward branches to paragraphs is used to 
bDackstuff all previous references to the called procedure. 


Once loaded the address is known so no futher action is 
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required. See figure [III-&] for an illustration of a 
subroutine table entry. 

The INTRDR routine reads the interpreter program into 
memory and transfers control to it. 

The intermediate code instructions fall eet 10 two 
categories: 1.) instructions used by BUILD to establish the 
run time environmert and, 2.) instructions to be executed by 
the interpreter. The following four ius tructions are 
generated in the compiler for use by the EUILD routire; SCD, 
mur, Bol, and TER. 

The SCD (start code) instruction is the last instruction 
generated by PART ONE and indicates where the first 
mmoeuvavle instruction for the intermediate code is to be 
loaded. This corresponds to the address immediately 
following the data area in the opseudo-macnine. See Figure 
(III-1] which illustrates the relative location of the 
address that is associated with the SCD instruction. Figure 
[IIl1I-4] illustrates the memory organization of the 


pseudo-machine when subroutines are used. 
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MEMORY ORGANIZATION AFTER BUILD AND INTRDR 
HAVE BEEN LOADED INTO MEMORY 
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The INT (initialize) instruction causes the BUILD 
routine Vomeinitagiize "the “data area with the values 
associated with those identifiers in the TATA DIVISION of 
the source program that had VALUE CLAUSES. In addition, the 
INT instruction causes the BUILD routine to initialize the 
constants area with all the edit masks for those identifiers 
of the numeric and alphanumeric edit type, and all literals 
ercountered in the PROCEDURE DIVISION of the source program. 

The RST (bdackstuff) instruction reselves all unresolved 
refererces, i.e. branches to labels defined after the 
respective PERFORM or GO statement was eéncountered in the 
source program. 

The TER (terminate) instruction is the last instruction 
generated by PART TWO of the compiler and indicates the end 
of the intermediate coce file. Upon encountering a TER 
instruction in the intermediate code the EBUILD routine 
MmoeertsS a STP instruction in its place. The STP instruction 
will cause the interpreter to terminate interpretaticn of 
the program when encountered. 

All other code generated by the compiler is copied into 
tHE code area of the pseudo-machine by the BUILD routine. 
See Figure [III-3] for an illustration of the mrerory 
MeedoiZation at this point in the initialization routine. 
The final action taken by the BUILD routine is to rove the 
INTRDR routine into the input buffer at &@H and transfer 


control to it. This frees the area from 1@@F to the base of 
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the data area for the interovreter. 

The INTRDR routine reads the interpreter program into 
memory starting at 10@0H and transfers control to it. From 
this point on the interpreter program executes the 


intermediate code that was loaded into the pseudo-machine. 
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MEMORY ORGANIZATION AFTER INTERMEDIATE CODF IS 
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SUBPROGRAM TABLE ENTRY 
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D. PSEUDO-MACHINE INSTRUCTIONS 
This sectior briefly covers the pseudo-machine 
instructions used in the interpreter, their format, end the 


actions which they accomplish. 
if format 


mel of the interpreter instructicns consist of an 
instruction number followed by a list of parameters. The 
following sections describe the instructions, list the re= 
mmerea parameters, and describe the actions taken by the 
machine in executing each instruction. In each case, parame- 
ters are denoted informally by the parameter nare enclosed 
in brackets. The BRN branching instruction, for example, 
uses the single parameter <branch address> which is the tar- 
get of the unconditional branch. 

As each instruction number is fetched from memory, 
the program counter is incremented by one. The program 
mumeever 15 then either incremented to the next instruction 
number, or a branch is taken. 

The three eighteen digit registers which are used by 
the instructions covered in the following sections are re- 


ferred to as registers zero, one, and two. 
2. Arithmetic Operations 


There are five arithmetic instructions which act 


upon the three registers. In all cases, the result is 
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Placed in register two. 


the input 


therefore, a 


Operations are allowed to destroy 


values during the process of creating a result, 


number loaded into a register is not availadle 


for a subsequent operation. 


ADD: 
and register 
Parameters: 

SUB: 
ore. 
Parameters: 

MUL: 
one. 
Parameters: 


DIV: 


register zero. 


Parameters: 


(addition). Sum the contents of register zero 
one. 
no parameters are reauired. 


(subtract). Subtract register zero from register 


no parameters are required. 


(multiply). Multiply register zero by register 
no parameters are reauired. 


(divide). Divide register one by the value in 
Tne remainder is not retained. 


no parameters are required 


RND: (round). Round register two to the last signifi- 


cant decimal 


Parameters: 


Oo. 


The 


place. 


no parameters are reauired. 


Branching 


machine contains the following flags which are 


used by the conditional instructions in this section. 
BRANCH flag ~~ indicates if a branch is to be taken; 


END OF RECORD flag -- indicates that an end of 


input condition has been reached when an attempt was made 
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to read input; 

OVERFLOW flag ~~ indicates the loss of irformation 
from a register due to a number exceeding the available 
size; 

INVALID flag -- indicates an invalid action in 
writing to a direct access storage device. 

All of the branch instructions are executed by 
changing the value of the program counter. Some are uncon- 
ditional branches and some test for condition flags which 
are set by other instructions. <A conditional branch is exe- 
cuted by testing the branch flag which is initialized to 
false. A true value causes a branch by changing the pro- 
gram counter to the value of the branch address. The branch 
flag is then reset to false. A false value causes the pro- 
gram counter to be incremented to the next sequential in- 
Seance tion. 

BRN: (branch to an address). Load the program 
counter with the <branch address>. 

Parameters: <branch address> 

The next three instructions share a common format. 
The memory field addressed by the <memory address> is 
checked for the <address length>, and if all the characters 
Match the test condition, the branch flag is complimented 
Parameters: <memory address> <address length> <branch ad- 
dress> 


CAL: (compare alphabetic). Compare a memory field 


4 
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moeredalphabetic characters. 

CNS: (compare numeric signed). Compare a field for 
numeric characters allowing for a sign character. 

CNU: (compare numeric unsigned). Compare a field for 
numeric characters only. 

DEC: (decrement a counter and branch if zero). 
Decrement the value of the <address counter> by one; if the 
result is zero before or after the decrement, the program 
counter is set to the <branch address>. If the result is 
not zero, the program counter is incremented by four. 
Parameters: <address courter> <bdrarnch address> 

EOR: (branch on END OF RECORD flag). If the END 
OF RECORD flag is true, it is set to false and the program 
counter is set to the <branch address>. If false, the pro- 
Sram counter is incremented by two. 

Parameters: <branch address> 

GDP: (go to - depending on). The memory location ad- 
dressed by the <number address> is read for the number of 
bytes indicated by the <memory length>. This number irdi- 
cates which of the <branch addresses> is to be used. Tne 
first parameter is a bound on the number of branch ad- 
dresses. If the number is within the range, the program 
counter is set to the indicated address. An out-of-bounds 
value causes tne pregram counter to be advanced to the next 
meemential instruction. 


Parameters: <bound number —- byte> <memory length> <merory 
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maress> <branch addr-1l> <branch addr-2> ... <branch addr-n> 

Mivemcbranmeneat INVALIDeflag true). If 
the invalid-file-action flag is true, then it is set to 
false, and the program counter is set to the branch ad- 
dress. If it is false, the program counter is incremented 
by two. 
Parameters: <branch address> 

PER: (perform). The code address addressed by the 
¢<change address> is loaded with the value of the <return ad- 
dress>. The program counter is then set to the <brarnch ad- 
dress>. 
Parameters: <branco address> <change address> <return ad- 
dress> 

RET: (return). If the value of the <branch address> 
meomenmot zero, then the program counter is set to its value, 
and the <branch address> is set to zero. If the <branch ad- 
dress> is zero, the program counter is incremented by two. 
Parameters: <branch address> 

REQ: (register equal). This instructior checks for a 
zero value in register two. If it is zero, the branch flag 
1s complemented. A conditional branch is taken. 
Parameters: <bdranch address> 

RGT: (register greater than). Register two is 
checked for a negative sign. If present, the branch flag is 
complemented. A conditional branch is taken. 


Parameters: <branch address> 
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RLT: (register less than). Register two is checked 
morea positive sign, and if present, the branch flag 1s com 
plemented. A conditional branch is taken. 

Parameters: <branch address> 

SER: (branch on size error). If the overflow flag is 
true, then the program counter is set to the branch address, 
and the overflow flag is set to false. If it 1s false, then 
the program counter is incremented by two. 

Parameters: <branch address> 

The next three instructions are of similar form in 
that they compare two strings and set the branch flag if 
meemcOndition is true. 

Parameters: <string addr-1> <string addr-2> <lengeth - ad- 
dress> <branch address> 

SEQ: (strings equal). The condition is true if the 
Strings are equal. 

SGT: (string greater than). The condition is true if 
String one is greater than String two. 

Pols (Straner less than). The condition is true if 


String one is less than String two. 
4. Moves 


The machine supports a variety of move operations 
for various formats end types of data. It does not support 
direct moves of numeric data from one memory field to anoth- 


er Instead, all numeric moves go through the registers. 


So 





The next seven instructions perform the same 
mumction. They load a register with a numeric value and 
differ only in the type of number that they exvect to see in 
memory at the <number address>. All seven instructions 
cause the program counter to be incremented by five. re. r 
common format is given below. 

Parameters: <number address> <byte length> <byte decimal 
count> <byte register to load> 

LOD: (load literal). Register two is loaded with a 
constant value. The decimal point indicator is not set in 
Miao instruction. The literal will have an actual decimal 
point in the string if required. 

LDi: (load numeric). Load a numeric field. 

LD2: (load postfix numeric). Load a nureric field 
with an internal trailing sign. 

LD3: (load prefix numeric). Load a rumeric field 
with an internal leading sien. 

LD4: (load separated postfix numeric). Load a numer- 
dc field with a separate leading sign. 

LD5: (load separated prefix numeric). Load a numeric 
field with a separate trailing sign. 

LD6: (load packed numeric). Load a packed numeric 
meld. 

MED: (move into alphanumeric edited field). The 
edit mask is loaded into the <to address> to set up the 


move, and then the <from address> information is loaded. The 
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meoreram counter is incremented by ten. 
Parameters: <to address> <from address> <leneth of rove 
address> <edit mask address> <edit mask length, address> 

MNE: (move into a numeric edited field). First the 
edit mask is loaded into the receiving field, and then the 
information is loaded. Any decimal point alignment required 
will be performed. Truncation of significant digits will not 
set the overflow flag. The program counter is incremented by 
wel ve . 
Parameters: <to address> <from address> <address length of 
move> <edit mask address> <address mask length> <byte to de- 
cimal count> <byte from decimal count> 

MOV: (move into an alphanumeric field). The memory 
field given by the <to address> is filled by the from field 
for the <move length> and then filled with blanks in the 
mombowing positions for the <fill court>d. 
Parameters: <to address> <from address> <address move 
length> <address fill count> 

STI: (store immediate register two). The contents of 
register two are stored into register zero and the decimal 
count and sign indicators are set. 
Parameters: none. 

The store instructions are grouped in the same order 
as the load instructions. Register two is stored into 
memory at the indicated location. Alignment is performed 


and any truncation of leading digits causes the overflow 
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mere to be set. Will six of the store instructions cause 
the program counter to be incremented by four. The format 
mor these instructiors is as follows. 
Parameters: <address to store into> <byte length> <byte de- 
ermal count> 

S20: suusitare numeric). Store into a@ numeric field. 

ST1: (store postfix numeric). Store into a numeric 
field with an internal trailing sien. 

Siz: (Store prefix numeric). Store into a numeric 
with an internal leading sign. 

ST3: (store separated postfix numeric). Store into a 
numeric field with a separate trailing sign. 

ST4: (store separated vrefix numeric). Store into a 
numeric field with a separate leading sign. 

STS: (store packed numeric). Store into a packed 


numeric field. 
=e lnput-Output 


The following instructions perform input and output 
overations. Files are defined as having the following 
emearacteristics: they are either sequential oor random 
and, in general, files created in one mode are not required 
Memoe readable in the other mode. Standard files consist 
of fixed length records, and variable length files need not 
be readable in a random mode. Mint ner.. Lnere== Mus. be 


Some Character or character string that delimits a variable 
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meneth record. 

ACs (accept jx Read from the system invut device 
{nto memory at the location given by the <memory address>. 
The program counter is incremented by three. 
Parameters: <memory address> <byte length of read> 

CLSizmulelose). Close the file whose file control 
block is addressed by the <fcb address>. The program counter 
{is incremented by two. 
Parameters: <fcb address> 

DIS: (display). Print the contents of the data field 
pointed to by <memory address> on the system output device 
for the indicated length and advance the line output if 
<flag> is set. The program counter is incremented by four. 
Parameters: <memory addressD <byte length> <flag> 

There are three open instructions with the seme for- 
mat. In e@ach case, the file defined by the file cortrol 
block referenced will be opened for the mode indicated. The 
program counter is incremented by two. 
Parameters: <fcb address> 

OPN: (open a file for input). 

OP1: (open a file for output). 

OP2: (open a file for both input and output). This 
is only valid for files on a random access device. 

The following file actions all share the same for- 
mat. Bach performs a file action on the file referenced by 


the file control block. The record to be acted upon is 
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given by the <record address>. The program counter is in- 
cremented by six. 

Parameters: <FCB address> <record address> <record length - 
address>. 

DLS: (delete a record froma sequential file). Re- 
move the record that was just read from the file. The file 
is required to be open in the input-output mode. 

RDF: (read a sequential file). Read the next record 
into the memory area. 

WEF: (write a record to a sequential file). Append a 
new record to the file. 

RVL: (read a variable length record). 

WVL: (write a variable length record). 

RWS: (rewrite sequential). The rewrite overation 
writes a record from memory to the file, overlaying the en 
record thet was read from the device. The file must be open 
in the input-output mode. 

The following file actions require random files 
rather than sequential files. They make use of a random file 
pointer which consists of a <relative address> and a <re- 
lative Fengt no. The memory field holds the number to be 
used in disk operations or contains the relative record 
number of the last disk action. The relative record number 
is an index into the file which addresses the record being 
accessed. After the file action, the program counter 


is incremented by nine. 
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Parameters: <FCB address> <record address> <record length - 
address> <relative address> <relative length - byte>. 

DLR: (delete a random record). Delete the record ad- 
dressed by the relative record numbder. 

RRR: (read random relative). Read a random record 
relative to the record number. 

RRS: (read random sequential). Read the next sequen- 
meat record from a random file. The relative record numbder 
of the record read is loaded into the memory reference. 

RWR: (rewrite a random record). 

WRR: (write random relative). Write a record inte 
the area indicated by the memory reference. 

WRS: (write random sequential). Write the next 
sequential record to a random file. The relative record 


number is returned. 
6. Subroutine Instructions 


The next three instructions are used to transfer 
control to a subroutine and pass the location of formal 
parameters. 

EXT: (exit subroutine). The program counter is set 
to the last value on the return stack and the actual 
partameters on the parameter stack are removed revealing any 
parameters that may be needed in the calling vrocedure. 
Parameters: No parameters are required. 


SBR: (call a subroutine). The program counter is 
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set to the beginning address of the called procedure. The 
return address is added to tne return stack. 
Parameters: <procedure name-8 bytes> 

PAR: (parameter list). The parameters are added to 
the parameter stack. 
Parameters: <number of parameters> <address parameter 1> 


<address parameter 2> ..... 
mee Special Instructions 


The remaining instructions perform special functions 
required by the machine that do rot relate to any of the 
previous groups. 

NEG: (negate). Complement the value of the branch 
flag. 

Parameters: No parameters are required. 

LDI: (load a code address direct). Load the  coae 
address located five bytes after the LDI instruction with 
the contents of <memory address> after it has been converted 
mormoinary. 

Parameters: <memory address> <length - byte> 

SCR: (calculate a subdscript). Load the subscript 
Stack with the value indicated from memory. The address 
loaded into the stack is the <initial address> plus an 
offset. Multiplying the <field length> by the number in the 
<memory reference> gives the offset value. 


Parameters: <initial address> <field length> <memory refer- 
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ence> <memory length> <stack level> 

STD: (stop display). Display the indicated informa- 
tior and then terminate the actions of the machine. The 
operator is given a choice to allow the machine to continue 
mreto terminate its actions. 
Parameters: <memory address> <length - byte> 

SLPS top). Terminate the actions of the machine. 
The following instructions are actually instructions to the 
build program in setting up the machine enviromnent and are 
not used in the normal execution of the machine. 
Parameters: no parameters are required. 

BST: (backstuff). Resolve a reference to a label. 
Labels may be referenced prior to their definition, requir- 
ing a chain of resolution addresses to be maintained in the 
code. The latest location to be resolved 1S maintained in 
the symbol table and a pointer at that location indicates 
the next previous location to be resolved. A zero pointer 
indicates no pricr occurrences of the label. The code ad- 
dress referenced by <change address> is examined and if 
it contains zero, it is loaded with the <new address>. if 
it is not zero, then the conterts are saved, and the 
process is repeated with the saved value as the change ad- 
dress after loading the <new address>. 
Parameters: <change address> <new address> 

INT: (initialize memory). Load memory with the <ir- 


put string> for the given length at the <memory address>. 
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Parameters: <memory address>» <address lenegth> <input 
String> 

SCD: (start code). Set the initial value of the pro- 
gram counter. 
Parameters: <start address> 

TER: (terminate). Terminate the initialization pro- 
cess and start executing code. 


Parameters: no parameters are required. 
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IV. SYSTEM DEBUGGING METHODS AND TOOLS 


A. DEBUGGING METHODOLOGY 


Initial debugging began with impvlementation of key 
components of the compiler/interpreter that had prevented 
use of the Navy’s ADPESO validation test programs. 
Additional work on the validation test programs was 
necassary to eliminate and/or correct minor errors within 
Byeeetest programs themselves. Once tnese errors were 
corrected the compiler/interpreter was able to comrile and 
execute the ADPESO programs completely and an overall view 
of the problems and errors within the system was available 
momeanelysis. 

Since compile time for each of the three main.modules -- 
Set) ONE, PART TWO, and INTERP -- took a mimimum of 
forty-five minutes, a step-wize refinemert technique was 
employed. First the simplest problems were corrected all at 
the same time. Once this was accomplished the remaining 
problems were handled one at a time to prevent introducing 
new problems from side effects of the corrections. Debugging 
could then be confined to only one problem and side effects 
kept to a minimum. This techniaue required more compilations 
but it was felt that attempting to correct more than one 
problem at a time could cause severe side effects with an 


increase in overall debugging time. 
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Eee INTERACTIVE TOOLS 


Because the MICRO-COBOL compiler and interpreter were 
implemented under the CP/M operating system, the Symbolic 
Instruction Debugger [7], SID, which expands upon the 
features of the Dynamic Debugging Tool [8], DDT, was 
mmparoyed. specifically, SID includes real-time breakpoints, 
fully monitored execution, symbolic disassembly, assembly, 
and memory disvlay and fill functions. One feature which 
allowed the setting of breakpoints at actual memory 
locations corresponding to a ovrogram’s source lines and 
symbolic names was used quite extensively. Another useful 
facility was the avility to display and alter the programs 
symbolic values, which enabled the substitution cf values to 


check a proposed solution to an error. 


C. CROSS REFERENCE LISTINGS 


Another useful facility which eased the debugging effort 
Meee tne cross reference listings produced by the PLM@g 
compiler used to compile the MICRO-COBOL compiler and 
interpreter. There were three different listings produced 
after each compilation: 1.) a line numbered source listing, 
2.) a Symbol address table, which included the name and 
actual memory address assigned for all symbols declared, and 
3.) a line address table which cross referenced every line 


in the source listing with the 8880 code generated by the 
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PLM8@ compiler for that particular line. These listings were 
almost indispensable with regard to testing and debugging, 


and their contribution cannot be overemphasized. 


Dee VALIDATION TESTS 


The primary method for discovering errors was the 
HYPO-COROL Compiler Validation System (ECCVS) Tape (from the 
Automated Data Processing Equipment Selection Office 
(ADPESO)). The transfer of these test vrograms from tape to 
a usable form on floppy diskettes was accomplished by Kiefer 
and Perry [14]. Additional errors were discovered through 
several peer test programs written to test areas that 
were not tested by the ADPESO programs or corstructs that 


were not contained in the HYPO-COBOL specifications. 
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VY. CONCLUSIONS AND RECOMMENDATIONS 


The entire MICRO-COBOL Compiler/Interpreter has been 
tested, debugged and documented. The following specific 
language features and facilities previously not implemented, 
or implemented incorrectly, have been successfully 
implemented, tested and debugged during this project: 1.) 
the compiler’s ability to handle any sequence of MICRO-COBOL 
Tanguage constructs (PIC CLAUSE, VALUE CLAUSE, OCCURS 
CLAUSE, and USAGE COMP-3 CLAUSE) in the declaration of an 
Moentifier, 2.) record identifier declaratiors with up to 
ten levels of elementary field items, 3.) record and 
elementary field identifier redefinitions, 4.) nested 
redefinitions, and 5.) error message generation ONY 
duplicate identifier declarations within the DATA DIVISION, 
rework of the BCD arithemetic package including the ROUND 
and SIZE ERROR options, 7.) implementation of the Move 
Numeric Edited command, 8.) implementation of nested 
IF-TEEN-ELSE statements, 9.) implementation of the PERFORM 
VARYING clause, 10.) modification of all MOVE commands, 11.) 
modification of the EXIT clause for use with subroutines, 
12.) modification of the STOP DISPLAY clause to allow 
Operator restart, 13.) implementation of subroutines 
including the CALL, USING and LINKAGE SECTION clauses, 14.) 


modification of the WRITE BEFORE/AFTER Grausie:, Heo) 
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implementation of COMP-3 and SIGN LEADING/TRAILING options, 
16.) addition cf the list and code compiler toggles to 
meeruce 4a list file ‘with errors and line numbers and the 
capability of surpressing code generation for ratrid syntax 
checking, and 17) expansion of the grammar to include the 
COMPUTE verb, the logical operators AND and OR , indexed 
files, and the relational operators <, > , and =". 

NPS MICRO-COBOCL compiles at a rate of approximately 5@@ 
lines per minute using a Z-8@ microprocessor with a 4MEZ 
clock on a standard eight inch floppy diskette. With the use 
of optional toggles such as NOSCODE or NOSLIST compilation 
rate increases to approximately 708 lines per minute and a 
maximum rate of approximately 9@9 lines per minute with both 
NOSCODE and NOSLIST toggles selected. Memory usage is kept 
to a minimum through the use of cverlays thus allowing 
fairly complex COBOL programs to be written and executed on 
a modest size microcomputer system. The present development 
system is designed to run in only 48K of main memory and can 
run in as little as e2@K or as much as the €4K maximum 
address space of an &@8@ or Z-82 microcomputer. These _ two 
features in addition to clear error diagnostics make the NPS 
MICRO-COBOL compiler/interpreter an excellent tool for 
teaching introductory COEOL programming. 

NPS MICRO-COBOL has been validated by the corvlete 
ADPESO validation test package for HYPO-COROL. In addition 


to the twenty-five test programs from that package, several 


99 





test programs designed to test the additional features 
implemented which were not in HYPO-COBOL and several 
application programs have veen compiled and executed to the 
sum of approximately 5@,@€0 lines of COROL code. 

In addition, the NPS MICRO-COBOL compiler documentation 
has beer updated. This documentation includes the following: 
1.) module organization, 2.) module interfaces, 3.) memory 
organization of the Interpreter, 4.) construction and data 
initialization of the symbol table, and 5.) key internal 
mea Structures. 

Several areas remain which could be implemented to 
enhance the NPS MICRO-COBOL compiler/interpreter system, 
these include: 1.) implementation of the COMPUTE verb, 2.) 
implementation of multiple Open’s, arid siec bose sets.) 
implementation of multi-dimensional tables, 4.) 
implementation of the logical operators AND and OR, ani 
5.) implerentation of the optional comparison operators < , 


">", and "=". 
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APPENDIX A 


NPS MIGRO-COBOL USER’S MANUAL 


VERSION 2.2 


Oe 
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I. ORGANIZATION 


The compiler is designed to run on an 8@8@ system ir an 
interactive mode through the use of a teletype or consoles. 
It requires at least 24K of main memory and a mass storage 
device for reading and writing. The compiler is composed of 
two parts , each of which reads a portion of the input file. 
Part One reads the input program to the end of the Data 
Division and builds the symbol table. At the end of the Data 
Division, Part One is overlayed by Part Two which uses the 
Symbol table to produce the code. The output code is written 
as it is produced to minimize the use of internal storage. 

The EXEC Program builds the core image fOr the 
intermediate code and performs such functions as 
backstuffirg addresses and offsetting address Pe 
subroutines. EXEC then copies the interpreter(CINTERP.COM) 
into memory and transfers control to the it. The interpreter 
is controlled by a large case statement that decodes the 


instructions and performs the required actions. 


123 





It. MICRO-COBOL ELEMENTS 


This section contains a description of each element in 
the language and shows simple examples of their use. The 
following conventions are used in explaining the formats: 
Elements enclosed in broken braces < > are themselves 
complete entities and are described elsewhere in the ranual. 
Elements enclosed in obraces { } are choices, one of the 
elements which is to be used. Elements enclosed in brackets 
{ ] are optional. All elements in capital letters are 
reserved words and must be spelled exactly. 

User names are indicated in lower case. These names are 
unrestricted in length, however they must be unique within 
the first 15 characters. The only other restriction on user 
names is that the first character must be an alpha 
Character. The remainder of the user name can have any 
combination of representable characters in it. 

The input to the compiler does not need to corform to 
standard COBOL format. Free form input will be accepted as 
the default condition. If desired, sequence numbers can be 
entered in the first six positions of each line. However, a 
toggle needs to be set to cause the compiler to ignore the 


sequence numbers. 
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ume firs, Charg@eter position on ary line is used to 


indicate the following:- 


* - indicates a comment entry. 
; ~ indicates a debugging line. 


/ - indicates a page eject. 
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IDENTIFICATION DIVISION 


SooMeNtT : 
IDENTIFICATION DIVISION Format 
FORMAT: 
IDENTIFICATION DIVISION. 
PROGRAM-ID. <commert>d. 
[AUTHOR. <comment>.|] 
[DATE-WRITTEN. <commert>.] 
(SECURITY. <comment>.] 


DESCRIPTION: 


ims division provides information for oprogrem iden- 
Mmeewodgion 8 fOr the reader. The order of the lines Is 
mixed. 

BeAMPLES: 


IDENTIFICATION DIVISION. 
PeOGRAM-ID. SAMPLE. 


AUTHOR. HAL R POWELL. 
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ENVIRONMENT DIVISION 
ELEMENT: 
ENVIRONMENT DIVISION Yormat 
FORMAT: 
[ ENVIRONMENT DIVISION. 
CONFIGURATION SECTION. 
SOURCE-COMPUTER. <comment> [DEBUGGING MODE]. 
OBJECT-COMPUTER. <comment>. 
[INPUT-OUTPUT SECTION. 
FILE-CONTROL. 
Syme -cOnyrOl=eCmtUry> 4. . « 
[I-O-CONTROL. 
SAME file-name-1 file-name-2 [file-name-2] 
[file-name-4] [file-name-5]. J} J] | 


DESCRIPTION: 
This division determines the external nature of a 
file. In the case of CP/M all of the files used can be 
accessed either sequentially or randomly except for 


variable length files which are sequential only. The 
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debugging mode is also set dy this section. The 
DEBUGGING MODE clause is used in conjunction with the 
“3° to indicate conditional compilation. If this 
clause is specified all debugging lines (those with a 
“3s” in column one) ar® compiled. If this clause is not 
specified, all debugging lines are treated as 
comments. In addition the DEBUGGING MODE can 0bde 


specified by using the compiler toggle “D’. 
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<file-control-entry> 


ELEMENT: 


<file-control-entry> 


FORMAT: 


1. 


SELECT file-name 


ASSIGN implementor-name 


[ORGANIZATION SEQUENTIAL] 


[ACCESS SEQUENTIAL]. 


SELECT file-name 


ASSIGN implementor-name 


ORGANIZATION RELATIVE 


[ACCESS {SEOUENTIAL [RELATIVE data-name]}]. 


{RANDOM RELATIVE data-name } 


SELECT file-name 
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ASSIGN implementor-name 

ORSANIZATION INDEXED 

PACCESS {SEQUENTIAL}]. 
{RANDOM } 


PeocGHIPTION: 
The file-control-entry defines the type of file that 
the program expects to see. There is no difference on 
the diskette, but the type of reads and writes that 
are performed will differ. For CP/M the irplerentor 
name needs to conform to the normal specifications. 
Indexed is not implemented. 

EXAMPLES: 
SELECT CARDS 


ASSIGN CARD.FIL. 


SELECT RANDOM-FILE 


ASSIGN A.RAN 


ORGANIZATION RELATIVE 


ACCESS RANDOM RELATIVE RAND-FLAG. 
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DATA DIVISION 
ELEMENT: 
DATA DIVISION Format 
FORMAT: 
DATA DIVISION. 
[FILE SECTION. 
{FD file-name 
[BLOCK integer-1 RECORDS] 
[RECORD [integer-2 TO] integer-3] 
[LABEL RECORDS {STANDARD}] 
{OMITTED } 
(VALUE OF implementor-name-1 literal-1 
fimplementor-name-2 literal-2} ...}. 
{[<record-description-entry>] ...] ... 
(WORKING-STORAGE SECTION. 
{<record-description-entry>] ... ] 


[LINKAGE SECTION. 


eee 





[<record-description-entry>] ... ] 


PSScRIPTION: 
This is the section that describes how the data i15 
structured. There are no major differences from stan- 
dard COBOL except for the following: i, Lebel 
records make no sense on the diskette so no entry is 
required. 2. The VALUE OF clause likewise has nro 
meaning for CP/M. If a record is given two lengths as 
MoeereenD 12 TO 128, the fil* is taken to be variabdle 
length and can only be accessed in the sequential 


mode. See the section on files for more information. 





<comment> 


ELEMENT: 


<comment> 


FORMAT: 


any string of characters 


DESCRIPTION: 


A comment is a string of characters. it may include 
anything other than a period followed by a blank or a 
reserved word, elther of which terminate the string. 
Corments may be empty if desired, but the terminator 


is still required by the program. 


EXAMPLES : 


this is a comment 


anotheroneallruntogether 


88820 16K 
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<data-description-entry> 
ELEMENT: 
<data-description-entry> Format 
FORMAT: 
level-number {data-name} 
{FILLER } 
[REDEFINES data-name] 
(PIC character-string] 
[USAGE {COMP }] 
{COMP-3} 
{COMPUTATIONAL} 
{DISPLAY} 
(SIGN {LEADING} [SFPARATE]] 
{TRAILING} 
[OCCURS integer] 
[SYNC (LEFT ]] 


(RIGHT) 





(VALUE literal]. 


DESCRIPTION: 


This statement describes the specific attributes 


the data. Since the 8080 is a byte machine, there was 


no Meaning to the SYNC clause, and thus it has 


been implemented, however existing programs that are 


transfered to MICRO-COBOL and use this feature 


compile and execute successfully. All numeric data are 


Maintained in DISPLAY format or packed BCD if the 


COMP-3 option is used. 
EXAMPLES: 
@1 CARD-RECORD. 


emeoRt PIC K(5). 


@2 NEXT-PART PIC 99V39 USAGE DISPLAY. 


G2 FILLER. 


G3 NUMB PIC S$9(3)V¥9 SIGN LEADING SFPARATE. 


@3 LONG-NUMB 9(15). 


93 STRING REDEFINES LONG-NUMB PIC X(15). 


G2 ARRAY PIC 99 OCCURS 184¢. 
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PROCEDURE DIVISION 


ELEMENT: 


PROCEDURE DIVISION Format 


FORMAT: 


1. 


PROCEDURE DIVISION [USING name1 [namez2] ... [name5]]. 


section~name SECTION. 


[paragraph-name. <sentence> [<sentence> ... ] ... |] «e. 


PROCEDURE DIVISION (USING name1 [nameZ] ... [name5]]. 
paragraph-name. <sentence> [<sentence> ...] ... 


DESCRIPTION: 
As is indicated, if the program is to contain sec- 


tions, then the first paragraph must be in a section. 


APO 





ELEMENT: 


<sentence> 


FORMAT: 


<imperative-statement> 


<conditional-statement> 


<sentence> 





<imperative-statement> 


ELEMENT: 


<imperative-statement> 


FORMAT: 


The following verbs are always imveratives: 


ACCEPT 


CALL 


CLOSE 


DISPLAY 


EXIT 


MOVE 


OPEN 


PERFORM 


SLOP 


The following May be imperatives: 
arithmetic verbs without the SIZE ERROR statement 


and DELETE, WRITE, and REWRITE without the INVALID option. 





<conditional-statements> 


ELEMENT: 


<conditional-statements> 


FORMAT: 


IF 


READ 


arithmetic vervds with the SIZE ERROR statement 


and DELETE, WRITE, and REWRITE with the INVALID option. 





ELEMENT: 


ACCEPT 


FORMAT: 


ACCEPT <identifier>d 


DESCRIPTION: 


This statement reads up to 


console. The usage of the 


EXAMPLES: 


ACCEPT IMMAGE. 


ACCEPT NUM(Q). 
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ACCEPT 


Zoo Cchanactvers.from the 


item must be DISPLAY. 





ADD 


ELEMENT: 


ADD 


FORMAT: 


ADD {identifier-1} [{{identifier-2 }] ... TO identifier—m 


{literal-1 } {literal-2 } 


[ROUNDED] [SIZE ERROR <imperative-statement>] 


DESCRIPTION: 
This instruction adds either one number to a 
second with the result being placed in the last loca- 
tion. Multiple adds have not been implemented. 
EXAMPLES: 
ADD 10 TO NUM31 


ADD X TO Z ROUNDED. ' 


ADD 10@ TO NUMBER SIZE ERROR GO ERROR-LOC 
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CALL 
ELEMENT: 
CALL 
mORMAT s 
CALL literal (USING namei [name2] ... [nameN}]] 


DESCRIPTION: 
Control is transfered to the called procedure with an 
address of each of the parameters to be passed. The 
parameters map to those in the linkaze section of the 
called program. The type and size of the parameters 
must match exactly. 

EXAMPLES : 
CALL °NC152° USING DN1 


oAoL PRINT” 


CALL “ADDLIST” USING VAR1 VAR2 VARS 


ec 





CLOSE 


ELEMENT: 


CLOSE 


FORMAT: 


CLOSE file-name 


DESCRIPTION: 
Files must be closed if tney have been written. How 
ever, the normal requirement to close an input file 
prior to the end of processing does not exist. 
EXAMPLES: 
CLOSE FILE1 


CLOSE RANDFILE 
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DELETE 


ELEMENT: 


DELETE 


FORMAT: 


DELETE file-name [INVALID <imperative-statement>] 


DESCRIPTION: 
This statement requires the file-name of the item 
to be deletea. The record is logically removed by 
filling it with a high value character, which is not 
displayable to the console or line printer. The log- 
ical record space can be used again by writing a 
valid record in its place. 

EXAMPLES: 
DELETE FILE-NAME 
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DISPLAY 
ELEMENT: 
DISPLAY 
FORMAT: 
DISPLAY {identifier} [{identifier-1}] . .. [f{identifier-N}] 
Meiyvercaion}eetliteral—-) ~} . .. {literal-n i} 


DESCRIPTION: 
This displays the contents of an identifier or 
displays a literal on the console. Usage must be 
DISPLAY. The maximum leneth of the display is @@ char- 
acters for literal values and 255 characters for 
aaentifiers. 

EXAMPLES : 


DISPLAY MESSAGE-1 
DISPLAY MESSAGE-3 14 


DISPLAY “THIS MUST BE THE END’ 
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DIVIDE 
ELEMENT: 
DIVIDE 
FORMAT: 
DIVIDE {identifier} INTO identifier-1 [ROUNDED] 
{literal } 
[SIZE ERROR <imperative-statement>] 


Pe GRIPTION: 
mime result of the division is stored in identifier-1; 
any remainder is lost. 

EXAMPLES: 
DIVIDE NUME INTO STORE 


DIVIDE 25 INTC RESULT 
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EXIT 


ELEMENT: 


EXIT 


FORMAT: 


EXIT (PROGRAM] 


DESCRIPTION: 


The EXIT command causes no action by the interpreter 
but allows for an empty paragraph for the corstructior 
of a common return point. The optional PROGRAM termi- 
nates a subroutine and returns to the calling program. 
It’s use in the main program couses no action to be 


taken. 


EXAMPLES: 


EXIT PROGRAM 


EXIT 
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GO 
ELEMENT: 
GO 
FORMAT: 


1. 


GO procedure-name 


GO procedure-1 [procedure-2] ... procedure-2@2 
DEPENDING identifier 
PeocRIPTION: 
The GO command causes an unconditional branch to tne 
routine specified. The second form causes a forward 
branch depending on the value of the contents of the 
identifier. The identifier must be a numeric integer 
value. There can be no more than 28 procedure names. 
EXAMPLES: 


GO READ-CARD. 
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GO READ1 READ2Z READS DEPENDING READ-INDEX. 
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If 


ELEMENT: 


If 


FORMAT: 


IF <condition> {stmt-lst } END-IF 


IF <corndition> {stmt-lst } ELSE {stmt-lst} END-IF 


{NEXT SENTENCE} {NEXT SENTENCE} 


DESCRIPTION: 
This is an enhanced version of the standard COBOL IF 
statement. Nesting of IF Statemerts is allowed. 
EXAMPLES: 
I¥ A GREATER B ADD A TO C ELSE GO ERROR-ONE END-IF. 


IF A NOT NUMERIC NEXT SENTENCE ELSE MOVE ZERO TO A END-IF. 


PPA LESS B 


PiSe LAY tf 


DISPLAY B END-IF. 


IF A GREATER B 


DISPLAY A 


DISPLAY B 


13@ 





ELSE 


DISPLAY C 


DISPLAY D END-IF. 


IF A GREATER B 


IF A GREATER C 


Dis hLAy x 


ELSE 


DiISruoAy C 


END-IF 


ELSE 


IF B GREATER C 


Dior ia 5 


ELSE 


DISPLAY C 


END-IF 


END-IF. 
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MOVE 


ELEMENT: 


MOVE 


FORMAT: 


MOVE {identifier-1} TO identifier-2 


{literal } 


DESCRIPTION: 


The standard list of allowable moves applies to this 
action. AS a Space saving feature of this implemerta- 
tion, all numeric moves go through the accumulators. 
This makes numeric moves slower than alpha-numeric 
moves, and where possible they should be avoided. Any 
move that involves picture clauses that are exactly 
the same can be accomplished as an alpha-numeric move 
if the elements are redefined as alpha-numeric; also 


all group moves are alpha-numeric. 


EXAMPLES: 


MOVE SPACE TO PRINT-LINE. 


MOVE A(1@) TO E(PTR). 
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MULTIPLY 


ELEMENT: 


MULTIPLY 


FORMAT: 
MULTIPLY {identifier} BY identifier-2 [ROUNDED] 
{literal } 
[SIZE ERROR <imperative-statement>] 


DESCRIPTION: 
The multiply routine uses a double length register to 
Calculate the result. This allows the result generated 
to be of maximum precision. The actual value stored 
will be determined by the amount of storage allocated 
for the variable. Overflow will occur if the number in 
the register is larger than the variable. If the 
precision in the register is greater than the variable 
trucation occurs unless the round option is specified. 
EXAMPLES: 
mur IPLY X BY Y. 


MULTIPLY A BY B(7) SIZE ERROR GO OVERFLOW. 
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OPEN 


ELEMENT: 


OPEN 


FORMAT: 


OPEN {INPUT file-name-1 } [{file-name-2}] ... 


{OUTPUT file-name-1} [{file-name-2}] ... 


{I-0 file-name-1 } {{file-name-2}] ... 


DESCRIPTION: 
The three types of OPENS have exactly the same effect 
on the diskette. However, they do allow for internal 
checking of the other file actions. For example, a 
write to a file set open as input will cause a fatal 
error. Multiple opers have not been implemented. 
EXAMPLES : 
OPEN INPUT CARDS. 


OPEN OUTPUT REPORT-FILE. 
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Peake OR 
ELEMENT: 
PERFORM 
FORMAT: 
Is 


PERFORM procedure-name [THRU procedure-name-2} 


PERFORM procedure-name [THRU procedure-name-2] 
{identifier} TIMES 


{integer } 


PERFORM procedure-name [THRU procedure-name-2] 


UNTIL <condition> 


PERFORM procedure-name VARYING {identifier} 
FROM {identifier} BY {identifier} 


UNTIL <condition> 
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BEoCRIPTION: 
All four options are supported. Branching may be ei- 
ther forward or backward, and the procedures called 
may have perform statements in them as long as the end 
points do not coincide or overlap. 

EXAMPLES: 


PERFORM OPEN-ROUTINE. 

PERFORM TOTALS THRU END-REPORT. 

PERFORM SUM 18 TIMES. 

PERFORM SKIP-LINE UNTIL PG-CNT GREATFR eo. 
PERFORM REPEAT—AGAIN VARYING COUNTER FROM 1 BY 2 


UNTIL COUNTER EQUAL 18. 
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READ 


ELEMENT: 


READ 


FORMAT: 


ie 


READ file-name INVALID <imperative-statement> 


READ file-name END <imperative-statement> 


DESCRIPTION: 
The invalid condition is only applicable to files in a 
random mode. All sequential files must have an END 
Svanement. 

ESAMPLES: 
READ CARDS END GO END-OF-FILE. 


READ RANDOM-FILE INVALID MOVE SPACES TO REC-1. 
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REWRITE 


ELEMENT: 


REWRITE 


FORMAT: 


REWRITE record-name [INVALID <imperative>] 


DEOCRIPTION: 
REWRITE is only valid for files that are open in the 


I-O mode. The INVALID clause is only valid for random 
files. This statement results in the current record 
being written back into the place that it was just 
read from, the last executed read. 

EXAMPLES: 
REWRITE CARDS. 


REWRITE RAND-1 INVALID PERFORM ERROR-CHECK. 
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STOP 


ELEMENT: 
SOP 
FORMAT: 
STOP {RUN } 
APIECE nay | 


DESCRIPTION: 
This statement stops execution of the program. I[f a 
literal is specified, then the literal is dispvlayed on 
the console and a prompt is displayed giving tne 
Operator the option of terminating or continuing 
program execution. 

EXAMPLES: 
Sor RUN. 


ror 1. 
STOP “INVALID FINISH’. 


For the last two examples the following prompt is 
displayed: 


OPERATOR ENTER A <CR> TO CONTINUE 
OR ENTER AN S TO TERMINATE. 
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SUBTRACT 


ELEMENT: 


SUBTRACT 


FORMAT: 


SUBTRACT f{iaentifier-1} f{identifier-2] ... FROM identifier-m 


{literal-1 } {literal-2 | 


[ROUNDED] [SIZE ERROR <imperative-statement>] 


DESCRIPTION: 
Identifier-m is decremented by the value of 
identifier/literal one. The results are stored back 
in identifier-m. Rounding and size error options are 
available if desired. Multiple subtracts have not been 
implemented. 

PRAMPLES : 
SUBTRACT 18 FROM SUB(12). 


SURTRACT A FROM C ROUNDED. 





WRITE 


PeeMeNTs 


WRITE 


FORMAT: 


1. 


WRITE record-name [{BEFORE} ADVANCING {INTFGER}] 


{AFTER } {PAGE } 


WRITE record-name INVALID <imperative-statement> 


DESCRIPTION: 
The record specified is written to the fils 
Soecitled in the file section of the source 
program. The INVALID option only applies to 
mandom files. 

EXAMPLES: 
WRITE OUT-FILE. 


WRITE RAND-FILE INVALID PERFORM ERROR-RECOV. 
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Ccond:t.on> 


ELEMENT: 


<condition> 


FORMAT: 


RELATIONAL CONDITION: 


{identifier-1} [NOT] {GREATER} {identifier-2} 


{literal-1} {LESS } {literal-2 } 


{EQUAL } 


CLASS CONDITION: 


identifier [NOT] {NUMERIC } 


{ALPHABETIC} 


BeocRIPTIONs: 
It is not valid to compare two literals. The class 
condition NUMERIC will allow for a sign if the iden- 
tifier is signed numeric. 

EXAMPLES: 
AONOT LESS 12@. 


LINE GREATER °C’. 


NUMB1 NOT NUMERIC 
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SUvsSerl pling 


ELEMENT: 


Subscripting 


FORMAT: 


data-name (subscript) 


DESCRIPTION: 
Ary item defired with an OCCURS may be referenced by 
a subdscript. The subscript may be a literal integer, 
or it may be a data item that has been specified as an 
integer. If the subscript is signed, the sign must be 
positive at the time of its use. 

EXAMPLES: 
A(1@) 


ITEM(SUB) 
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III. COMPILER TOGGLES 


There are six compiler toggles which are contrelled by 
an entry following the compiler activation command, COBOL 
<filename>. The format of the entry consists of following 
<filename> by one space and then entering a “$ followed 
immediately by the desired toggles. There must be only one 
space after <filename> and no spaces between the $ and the 
toggles. The following is an example of a typical entry: 

COBOL EXAMPLE $5 
This entry would cause the compiler to ignore the first six 
characters(used for Sequence numbers) at the >beginning of 
each input line. In each case tne toggle reverses the 


default value. 


$C -- No intermediate code. Default is off. Setting this 
toggle speeds initial compilation for Syntax checking. When 


this toggle is set the CIN file is empty. 


9D -- Debugging mode. Default is off. This toggle sets 
the debugging mode, which means all debugging lines(those 
with a “:° in column one) are compiled. If this toggle is 
not set and the DEBUGGING MODE is not set in the ENVIRONMENT 
DIVISION of the source program all debugging lines are 


treated as comments. 


SL -- list the input code on the screen as the program 
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is compiled. Default is on. Error messages are dispvlayed at 


the terminal in any case. 


SP -— Productions. List productions as they occur. 


Default is off. 


SS -- sequence numbers are in the first six positions of 


each record. Default is off. 


ST -- Tokens. List tokens from the scanner. Default is 
off. 

SW -- Create a list file. Default is off. A listing file 
is created when this toggle is set. When this toggle is not 


set the LST file will only contain error messages. 
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IV. RUN TIME CONVENTIONS 


This section explains how to run the compiler on _ the 
current system. The compiler expects to see a file with a 
type of CBL as the input file. In general, the input is free 
form. If the input includes sequence numbers then the 
compiler must be notified by setting the appropriate togéle. 
The compiler is started by typing COS80L <file-name>. Where 
the file name is the system name of the input file. There is 
no interaction required to start the second part of tae 
compiler. The output file will have the same <file-name> as 
the input file, and will be given a file type of CIN. Any 
previous copies of the file will be erased. As with the CIN 
file a LST file will be created with the same file name as 
the input file and any previous LST files with that name 
will be erased. 

The interpreter is started by typing EXEC <filename>d. 
The first program is a loader, and it will display "NPS 
MICRO-COBOL LOADER VERS 1.0 followed by the display "LOAD 
FINISHED to indicate successful completion. The run-time 
package will be brought in by the EXEC routire, and 
execution should continue without interruption. Succesful 
transfer of control to the interpreter will be indicated Ddy 
the display NPS MICRO-COBOL INTERPRETER VERS 1.9". 
Completion of program exection will be indicated by the 


ov 


display X EXECTION ERROR(S) , where X is the number of 
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rors which occured during execution. 


147 





V. FILE INTERACTIONS WITH CP/M 


The file structure that is expected by the program 
imposes some restrictions on the system. References 4 and 5 
Gentain detailed information on the facilities of CP/M, and 
should be consulted for details. The information that has 
been included in this section is intended to explain where 
limitations exist and how the program interacts with the 
system. 

All files in CP/M are on a random access device, and 
there is no way for the system to distinguish sequertial 
files from files created in a random mode. This means that 
the various types of reads and writes are all valid to any 
Mme that has fixed length records. The restrictions of tke 
ASSIGN -statement prevert a file from being open for both 
random and sequential actions during oné program. 

Each logical record is terminated by a carriage return 
and a line feed. In the case of variable length records, 
this is the only end mark that exists. This convention was 
adopted to allow the various programs which are used in CP/M 
to work with the files. Files created by the editor, for 
example, will generally be variable lergth files. This 
convention removes the capability of reading variable lergth 
files in a random mode. 

All of the physical records are 128 bytes in length, and 


the program supplies buffer space for these records in 
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addition to the logical records. Logical records May be of 


eny desired length. 
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Ee 


CL 


MA 


MO 


OP 


SO 


WR 


CC 


CE 


VI. ERROR MESSAGES 


A. COMPILER FATAL MESSAGES 


meroeredd -~- disk error, no corrective action can be 


taken in the program. 


Close error -- unable to close the output file. 
foee error ——- Could not create the output file. 
Memory overflow -- the code and constentS generated 


will not fit in the alloted memory space. 

Omen error —— Can not open the input file, or no such 
Mele present. 

Stack overflow -- the LALR(1) parsing stack has exceeded 
its maximum allowable size. 

Symbol table overflow =-- symbol table is too large for 
the allocated Space. 

Seeeve Crror —- disk error, could not write 4a code 


record to the disk. 


B. COMPILER WARNINGS 


Carriage Control error -- The WRITE REFORE/AFTER 
ADVANCING option can only be used with sequential files. 


Close error -- attempted to close a non-existing file. 


150 





DD 


EL 
FT 


IA 


Iv 


LS 


LT 


LE 


LV 


L? 
MD 


MS 


NF 


NI 


Duspimaeate sPeclaration -- the identifier name has been 
previously declared. 

Extra levels -- only 10 levels are allowed. 

File type -- the data element used ina read or write 
Statement is mot a file name. 

Invalid access -- the specified options are not an 
allowable comodination. 

Identifier stack overflow -~ more tnan e€ items ir a 
GO -- DEPENDING statement. 

iigelbbd SUBSCriptw=— an item was subscripted but it 
was not defined by an OCCURS. 

momelid type ~= the field types do not match fer this 
statement. 

Literal error -~- a literal value was assigned to an 
item that is part of a group item previously assigned 
aed Lue. 

Literal value error -- the PICTURE clause field tyve 
does not match the VALUE clause literal tyne. 

evel 77 error -- level 77 used incorrectly. 

Multiple decimals -- a numeric literal in a VALUE 
clause contains more than one decimal point. 

Multiple signs -- a signed numeric literal in a VALUE 
clause contains more than one sign. 

No file assigned -— there was no SELECT clause for 
this file. 


Not implemented -- a production was used that is rot 
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NN 


NP 


NV 


OF 


OL 


PC 


Fi 


Ee 


PS 


i 


PE 


PF 


implemented. 

Non-numeric -- an invalid character was fcund in a 
numeric String. 

foeproauGction =- no production exists for the cuurrent 
parser configuration; error recovery will automatically 
Occur. 

Numeric value -- a numeric value was assigned te a 
non-numeric item. 

Open error -- attempt to open a file that was not de- 
clared; or attempted to open a file for [-0O that was 
not a RELATIVE file. 

OCCURS LEVEL -- 91 and 77 levels can not contain an 
occurs clause. 

Picture clause -- a pic clause exceeds 2¢ characters. 
More than one float symbol declared. 

Non-numeric data in repetition clause or missing right 
parenthesis. 

Invalid or incompatable symbol in pic clause. 

Invalid symbol(s) embedded within a float symbol 

omy /,0,38B, ,» allowed. 

Invalid combination of symbols in pic clause, type cannot 
be determined. 

Number of possible numeric entries exceeds register length 
max is 18. 

Paragraph first -- a section header was produced after 


a paragraph header, which is not ina section. 
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Ri 


R2 


RS 


SE 


SG 


SL 


TE 


UD 


UL 


VE 


WL 


Redefine nesting -- a redefinition was made for. an 
item which is part of a redefined item. 

Redefine length -- the length of the redefinition item 
was greater than the item that it redefined. That 

is only allowed at the 91 level. This error 

message may be printed out one identifier past the 
medetrining identifier record in which it occurred. 
Redefines misplaced -- a redefines was attempted in the 
FILE SECTION of the source program. 

scanner error -—- the scanner was unable to read an 
mientvinver dye to an vinvalid character. 

Sign error -- either a sign was expected and not 
found, or a sign was present when not valid. 
Significance loss -~- the number assigned as a value is 
larger than the field defined. 

Type error -- the type of a subscript index is not 


integer numeric. 


Undeclared identifier -- the identifier was not 
declared. 
Unresolved label -- label has not been referenced. 


This warning will be given to all references to 
external subroutines. 

Value error -- a value statement was assigned to an 
item in the file section. 

Wrong level error -- program attempted to write a 


record other than an @1 level record to an output 
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CL 


CO 


ME 


NF 


OF 


OP 
PS 


50 
Wi 


mc 


fire. 


C. INTERPRETER FATAL FRRORS 


Close error ~-- the system was unable to close an output 
file. 
Call stack Overflow -- insufficient memory avallable to 


transfer varable address’ and/or return location for a 
subroutine call. 
Make error -- the system was unable to mak® an output 
file on the disk. 
mome rte —= an dnput file with the given name could rot 


be opened. 


Open Error -- attempt to open a file which was already 
open. 

Open Error -- the system was unable to open a file. 
Procedure Stack -- rot enough memory to load all 


subroutines. 

Subroutine Overflow -- subroutine symbol table overflow. 
Write non-sequential -- attempted to WRITE to a file 
opened for INPUT or a file opened for I[-0 when ACCESS 
was SEQUENTIAL. 

Wrong key -- attempted to change the key value to a 
lower value than the number of the last record writ- 


ten. 





WS 


W4 


WS 


W6 


Ww? 


EM 


GD 


Ic 


NE 


Write input -- attempted to WRITE to a file opened 


Gomerne Ul. 

Write non-empty -~- attempted to WRITE to a non-empty 
mec Om Gr. 

Read output -—- attempted to READ a file opened for 
SUTPUT . 

Rewrite error -~ attempted to REWRITE to a file 


not opened for I-00. 
Rewrite error -- attempted to REWRITE a record before 
reading the file; or multiple REWRITE attempts with- 


out doing a READ between each. 


D. INTERPRETER WARNING MESSAGES 


End mark -- a record that was read did not have a 
carriage return or a line feed in tne expected location. 
Go to depending -- the value of the depending indicator 
was greater than the number of available branch 
padresses. 

Invalid character -- an invalid character was loaded 
into an output field during an edited move. For example, 
a numeric character into an alphabetic-only 

field. 

Numeric Error -- non-numeric data in an arithmetic 


Operation. 
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We Write Error -~- the system was unable to write to an 


Sutputefite On the disk. Disk may be full. 


5! Sign Invalid -- the sign is not a + ora - 





APPENDIX B 


LIST OF MICRO-COBOL RESERVED WORDS 


The following is a list of reserved words for 
MICRO-COBOL. The reserved words are the same as those 
specified for the HYPO-COBOL language, except where noted 


with an asterisk (*). 


ACCEPT BCs Le = MODE ROUNDED 

meCeSS ENTER MOVE RUN 

ADD ENVIRONMENT MULTIPLY SAME 

ADVANCING EOF * NEXT SECTION 

AFTER EQUAL NO * SECURITY 

ALPHABETIC ERROR NOT SFLECT 

AND * eer NUMERIC SENTENCE 

ASSIGN FD OBJECT-COMPUTER SEPARATE 

AUTHOR FILE OccURS SEQUENTIAL 

BEFORE FILE-CONTROL OF SIGN 

BLOCK FILLER OMITTED SIZE 

BY FROM OPEN SOURCE-COMPUTER 

CALL GIVING * ORO = SPACE 

eLOSE GO ORGANIZATION STAN DARD 

COBOL GREATER OUTPUT STOP 

COMP raw PAGE SUETRACT 

forP-3 * I-O-CON TROL PERFORM SYNE 

COMPUTATIONAL*IDENTIFICATION PIC TERU 

COMPUTE * IF PROCEDURE TIMES 

CONFIGURATION INDEXED * PROGRAM TO 

DATA INPUT PROGRAM-ID TRAILING 

DATE-WRITTEN INPUT-OUTPUT QUOTE UNTIL 

DEBUGGING INSTALLATION * RANDOM USAGE 

DELETE INVALID READ USING 

DEPENDING INTO * RECORD VALUE 

DISPLAY LABEL RECORDS VARYING * 

DIVIDE LEADING REDEFINES WITH * 

DIVISION LEFT RELATIVE WORK INC -STORAGE 

ELSE Luss REWRITE WRITE 

END LINKAGE RIGHT ZERO 

In addition the arithemetic operators, +, “-", “*", "/" and 
xx" and the comparison operators >, < and = are in 


the reserved word list. None of these symbols are in in HYPO 
COBOL but have been added to the grammar of NPS MICRC-COBOL 
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9 enable greater flexiblity. 
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APPENDIX C 


The MICRO-COBOL compiler and interpreter source files 
currently exist in the high level language PLM&O and are 
edited and compiled under the ISIS operating system on a 
INTEL Corporaticn MDS system. This is a description of the 
procedures required to compile and establish the programs to 
compile and interpret a MICRO-COEFOL program. The MICRO-COBOL 
compiler/interpreter runs on any 89888 or 2-82 based 
microcomputer that operates under CP/M. The execution of the 
following four files will cause a MICRO-COBOL program to be 


compiled and executed: 


me COBOL.COM 
eee PARTZ.COM 
fee SAC .COM 

4. CINTERP.COM 


These four files are created from the following six 


PLM8@ source programs. 


meeranil .PLM 
Meee ARS 2.PLM 
pe SUILD.PLM 


i 
ie 
3 
4. READER.PLM 
See INTRDR.PLM 
G 


ee uNTERP.PLM 





The procedures used to create the four object files (COM 
files) involve compiling, linking, and locating each of the 
six source files under ISIS. The SID program is then used 
under CP/M to construct the executable files. Each of the 
following steps describe the action(s) to be taken and, 
where appropriate, the command string to be entered into the 
computer. 

1. An ISIS system disk containing the PLM8@ compiler is 
placed into drive A and a non-system disk containing the 
Source programs is placed into drive 8. It should »e roted 
that drive A and B are the CP/M reference names for the 
Merves While Fl and Fe are the ISIS reference names used for 
meenassociated disk drives. 

2. Compile the PLM source program under ISIS using the 


the following command: 


PLM8@ :Fl:<filename>. PLM DEBUG XREF 


DEBUG saves the symbol table and line files for later 
use during debugging sessions. XREF causes a cross-reference 
meotame, of all identifiers in the source program, to be 
created. The cross-reference listing includes each 
meentifier and fiend ssOCia leds Lane nunper where the 
identifier was declared and the line number of each 
Occurence of the identifier in the source program [12]. 


5. Link the PLM8@ object file. 
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LINK :Fi:<filename>.OBJ, TRINT.OBJ, PLME@.LIB, TO 
¢Fi:<filename>.MOD 


See reference 11 for an exflanation of PLMY&0.LIB. The 
TRINT.OBJ program interfaces the MON1 and MON2 functions of 
CP/M to the source program, allowing for the use of absolute 
addresses in referencing these functions. 


4. Locate the object file. 
LOCATE :Fi:<filename>.MOD CODE(oreg address) 


The ‘org address is the address where the prograr will 
begin to be loaded into memory. The following are (org 


addresses for the associated program: 


ment l .MOD 1035 
Per 2 MOD 1Q035E 
INTERP .MOD 1038 
INTRDR .MOD GOH 
BUILD.MOD 12354 


READER .MOD OBOOOH 


The org addresses above represent the ones used with a 62K 
byte CP/M system. The only address that would need to be 
Changed if a different size system was used would be the one 
for IREADER.MOD. See appendix EF for specifics on the adéress 
to use for IREADER. 


4a. The two files INTRDR and IREADFP just created by the 
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LOCATE command must be converted to HEX FILES. By using 
the ISIS command OBJHEX <filename> the file will be 
converted to the HEX file <filename>.HEX. 

5. Replace the ISIS system disk ir drive A with a CP/M 
system disk and reboot the system. 

eee transfer the located 1518S file from the [SI5 disk on 


drive B to the CP/M disk on drive A. 
FROMISIS <filename> 


Ga. When transfering the HEX files to the CP/M disk 


use the following: 
FROMISIS <filename>.HEX 
7. Convert the ISIS file to a CP/M executable form. 
OBJCPM <filename> 


7a. The “HEX files are not coverted to a CP/M format, 
Sureare left in HEX format. 

7d>. The file INTERP should be renamed to CINTERP using 
the command =9REN CINTERP=INTERP before the file is 
converted to CP/M executable form. This is nessacary because 
the ISIS operating system allows file names to be only six 
letters in length. When FXEFC.COM is executed, the message 
“CINTERP.COM NOT FOUND” will be displayed if this step is 
mot omitted. 


At this point the object file is in machine readable 
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form and will run under CP/M when called properly. PART2.COM 
and CINTERP.COM are called by PART1.COM (COBOL.COM) and 
BUILD.COM (EXEC.COM), respectively and need no further work. 
GOFOL.COM and EXEC.COM need to be constructed from the 
remaining four files. 


COROL.COM is created by entering the following commands: 


meeci) PARTI.COM 
ee” 6=6LREADER. HEX 
3. R&EO 
4. AS14A 
5S. JMP @BEO?e 

= vcontrol—-C 


6 
7. Save 56 COBOL.COM 


See reference 7 for an explanation of the I, R, and 
"A commands used above and ref 5 for an explanation of the 
"SAVE command. Steps four and five above are used to patch 
the JUMP to READER referred to in the PART1.PLM program into 
the PART1.COM program. It should be noted that each time 
PART ONE is changed and recompiled the address of the 
“patch” instruction (step 4 adove) will change. Use of the L 
command will aid in locating the address that needs to be 
Changed. The assembly language code will have the following 
form: S14A JMP S14A. 


EXEC.CCM is created by entering the following commands: 


162 





me ol D BUILD. COM 

eet INTRDR HEX 

S. R1ICG2 

4. CONTROL-C 

5. SAVE 31 EXeC.COM 


NPS MICRO-COBOL programs may now de executed in the 
following manner. The source program is named, 
<filename>.CBL. The command COBOL <filename> , causes the 
MICRO-COBOL source program to be read into memory and 
mompried. During the compilation, the intermediate code 
file, <filename>.CIN, is written out to the disk as the code 
is generated. The command “EXEC <filename>’, causes the 


file, <filename>.CIN, to be executed. 
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APPENDIX D 


PART ONE AND PART TwO INTERNAL DATA STRUCTURES 
AND SIGNIFICANT VARIABLES 


Within PART ONE and PART TWO, many significant data 
structures are used by the procedures which constitute tne 
scanner and parser. Descriptions are given below for those 
Structures regarded as important and necessary for future 


compiler development. 
meee interfacing Structures 


AmDSEND =-— this variable is used to hold the end of file 
Meprer for the erd of the source program. 

BUFFER(11) -- byte array used to hold the filenare and 
Mmemeuype if declared, of an input or output file in the 
SELECT CLAUSE of the FILE SECTION of a MICRO-COBOL source 
program. 

BUFFERSEND -- address variable which marks the last byte 
of the compiler input buffer which is a 128 byte buffer used 
for reading the source program. 

ERRORSCTR(5) -- byte array used to hold a count of the 
total number of errors. 

INSADDR -- address variable, default file control block 
used initially to hold the <filename.CBL> of the source 
Breeram to be compiled. 


INSEUFF -- literal value, marks the first byte of the 
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Gompiler input buffer. 

INPUTSFCB -- byte value, based at INSADDR(33), the dase 
momress of the default file control block of the source 
program. 

LINESCTR -- byte value that keeps track of the number of 
lines in the input file. Also used to write the line rumbers 
meethe list file. 

LISTSBUFF(128) -- byte array, used as a 128 byte output 
puffer for loading the generated list file. 

LISTSFCB(33) -- bvyte array for the list file, file 
control block. 

LISTSPTR —- address value, used as an index irto the 
list buffer (LISTSBUFF). 

OUTPUTSBUFF(128) -- byte array, used as a 128 byte 
output buffer for loading the generated output (pseudo 
instructions) when writing to the intermediate code file. 

OUTPUTSCHAR -- byte value, based at the OUTPUTSPTR; used 
moemeraentify the particular byte of the output buffer 
(OUTPUTSBUFF) to which the next intermediate code 
mistruction is to be written. 

OUTPUTSEND -- address variable, pointer to the end of 
the output buffer (OUTPUTSEUFF). 

OUTPUTSFCB(33) -- byte array, the FCB for. the 
intermediate code file <filename.CIN> established in PART 
ONE of the compiler and pasted to PART TWO of the compiler 
by IREADER module. 
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PULPCPSPIR =- address walue, used as an index into the 
output buffer (OUTPUTSBUFF). 
POINTER -- address value, the address of the byte 


holding the next input character of the source program. 
<. Pebugging Structures 


DEBUGGING —— logical byte value, toggle used in 
conjunction with : in a MICRO-COROL source program text} 
allows POmeebne sGomollation or non-compilation of the 
deugging statements following the © 

ERROR -- logical byte value, toggle used to indicate an 
error condition and override a nolist conditicn thus 
allowing errors to be written to the list file reguardless 
of the writeslst toggle. 

LISTSINPUT -- logical byte value, tcggle used to display 
or not display a source program to the CRT during 
mompitiation. 

NOSCODE -- logical byte value, toggle used to stop code 
generation for faster syntax checking. 

PARMLIST(9) -- byte array used to hold the toggles set 
by the compiler developer or user upon execution of the 
command: COBOL <filename.CEL> STOGGLES. 

PRINTSPROD -- logical byte value, toggle used to print, 
in chronological order, at the CRT the production numbers of 
the compiler grammar rules used during a compilation of the 


source program. 
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PRINTSTOKEN -- logical byte value, toggle used to print 
tokens and the numbers assigned to them. 

SEQSNUM -- logical byte value, toggle used to indicate 
the presence of sequence numbers in the first six positions 
of each line of a source program being compiled. 

WRITESLST -- logical byte value, toggle used to indicate 
whether a list file is to be generated. A limited list file 
containing errors and the line being parsed at the tire of 
the error(s) is always created. 

UESFLAG -- logical byte value, toggle used to indicate 


whether there is an undeclared varible. 
53. Memory Structures 


FOFFILLER -- literal value, used to test for the 
occurrence of an end of file character ("1AB in CP/M), when 
reading the source program. 

FREESSTORAGE -- first free address following PART ONE of 
the compiler; utilized as the base of the symbol table. This 
is the same value as HASESTABSADDPR in PART TWO of the 
compiler. 

mr iLALSPOS -—- address value, the initial location of 
the IREADER module before it is copied to high memory at 
location MAXSMEMORY. | 

MAXSMEMORY -- address value, the location in high memory 
where the IREADFR module is to be moved. 


MAXSINTSMEM -- address value, the highest usable 
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addressable memory. This is the point where no more code can 
be generated due to insufficient memory. 

NEXTSAVAILABLE -- address value, the pseudo machine 
memory address for the next machine instruction. 

PARTISLEN -- the number of bytes of information saved in 
high memory after execution of PART ONE and used to 
initialize PART TWO module variables of the compiler. 

mapolSTOP -—— this address is used in conjuncticn with 
PASSISLEN for locating the fourty-eight bytes of information 
saved in PART ONE for use in PART TWO of the compiler. 

RDRSLENGTH -- literal value representing the 255 bytes 
of the IREADER module to be moved from INITIALSPOS to 


MAXSMEMORY. 
4. Scanner Structures: 


MmecUM(S51) -- an array of 51 bytes; the first byte 
contains a count of the total number of characters currently 
meine accumulator. This structure holds tokens as they are 
Scanned, and will hold either a reserved word, a user 
defined identifier, or a literal. 

COLLISION -- address varible, contained in first two 
bytes of an identifier’s symbol table entry and indicates 
M@etnmer there is another identifier which hashes to the same 
nash table address. This address points to that identifier’s 
address in the symool table. 


DISPLAY(88) -- an array of 74 bytes; the first byte 
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contains a count of the total number of characters (1-73) 
currently in the display buffer. Every line within a source 
program is loaded into this structure for subsequent 
Mnting to the CRT terminal during compilation. 

EDITSFLAG -- logical flag which denotes the fact that a 
“$° symbol has deen loaded into the DISPLAY array during 
compilation. When set the characters within DISPLAY will be 
mmereeea One at a time, until the entire line is printed. 

HASHSTABLESADDR -- the base of the symbol table 
generated in PART ONE, used as the base of the hashtable. 

HASHSTABSADDR -—- this was the address of the bottom of 
the symbol table generated in PART ONE of the compiler, and 
Beved for Part two. 

INPUTSSTR -— literal value (32), returned to the LALR(1) 
parser anytime the token contained in the ACCUM is not a 
meserved word or literal. 

LITERAL -—- literal value (15), returned to the LALR(1) 
Dearser anytime the first character encountered by the 
scanner is a quote (”), prior to loading the ACCUM. 

MAXSLEN -— length of the longest reserved word allowed 
by MICRO-COBOL. 


5. Parser Structures: 


BUFFER(31) -- byte array used to store edited PICTURE 
CLAUSE Characters for subsequent intermediated code 


generation. 
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COMPILING -- logical byt2 value which indicates that 
compiling is taking place or not in PART ONE or PART TWO; 
set to FALSE whenever the statestack of the LALR(1) parser 
is reduced to a recognizable finished state. 

CURSSYM -— address variable that holds the address of 
the current symbol being accessed in the symbol table. 

DUPSIDENSARRAY(24) -- address array that holds the 
symbol address for all files declared in the INPUT-OUTPUT 
SECTION of a source program. When the FILE SECTION entry for 
the file is encountered the array is searched to determine 
if the file was declared and to insure that a FILE SECTION 
entry had not been previously made. 

FILESDESCSFLAG -- logical byte value; indicates whether 
the compiler is compiling the FILE PESCRIPTION SECTION of a 
source program or not. 

FILESSECSEND --logical byte value set whenever the 
Parser has parsed passed the FILE SECTION of a Source 
program. 

HOLDSLIT(51) -=- byte array, first byte contains a count 
of the total number of characters currently stored in the 
HOLDLIT buffer which is used to hold characters for a VALUE 
CLAUSE. 

IDSSTACK(10) -- address array which functions as a stack 
and is used to hold the addresses of identifiers at both the 
record and elementary levels. Whenever a record identifier 


has nested elementary field identifiers it is saved on the 
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IDSSTACK. Also, anytime a record identifier has succeeding 
record identifiers redefining it, it is saved on the 
IDSSTACK. In the case of multiple record descriptions ina 
file description of the FILE SECTION, the record 
descriptions following tie MerSteerecord dre wassumed 
redefinitions. 

IDSSTACKSPTR -- a byte index variable into the IDSSTACK 
array. 

MAXSIDSLEN -- a numeric value (12), maximum length of 
any user defined identifier. 

MP —— byte index variable into the VALUE array. 

MPP1 -- byte index variable into the VALUE array, one 
byte above MP index. 

NEXTSSYM -- this address indicates the next available 
free space for a symbol table entry. 

PENDINGSLITERAL -- byte value (%,1,2,3,4,5), indicates 
the category of the target input to a VALUE CLAUSE. 

PENDINGSLITSID --— byte value (9,1,2,3,4,5), which is 
saved to indicate the category of the most Gecertly 
encountered target input to a VALUE CLAUSE. 

PRODUCTION -- byte value, determined by the parser and 
indicates the next semantic action to be taken by the 
compiler. 

REDFF -- logical byte value which allows the testing of 
an identifier’s storage value size against the storage value 


Size of a second identifier that redefines the first. Set to 
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TRUE when there are multiple record descriptions within a FD 
BLOCK in the FILE SECTION, or wnen a record or elementary 
identifier declaration in the WORKING STORAGE SECTION 
contains a REDEFINES CLAUSE. 

REDEFSFLAG -- logical byte value, used to denote the 
scanning and parsing of the FILE SECTION of a source 
program, helps in identifying duplicate identifiers within 
mars Section. 

REDEFSONE -~ address variable that holds the symbol 
table address of the identifier being redefined by another 
meentifier. 

REDEFSTWO -- an address variable that contains the 
symbol table address of an identifier which redefines 
another identifier. 

SP =- a byte index for the STATESTACK array and the 
VALUE array; points to the top of the STATESTACK array. 

STATE ~~ a byte value numeric quantity that indicates 
the current parser state. 

STATESTACK(42) -- a byte array which stacks the states 
(production sequences) the parser passes through while 
compiling a source program. 

TRUNCSFLAG -- logical byte value that indicates numeric 
truncation of an identifier’s VALUE CLAUSE input hasnt 
occurred, because the identifier’s associated PICTURE CLAUSE 
has not been scanned and parsed. 


VALUE(4@) -- an address array that holds addresses of 
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meentifiers, specific attributes of these identifiers and 
attributes of the current source program staterent oor 
sentence being parsed. 

VARC(51) -- a byte array, the first byte holds the court 
@eeeene total number of characters within it, used to hold 
@2l the ASCII characters of tokens scanned within the source 
program, excluding reserved words; for subsequent analysis 
and Meocessing. 

VALUESFLAG -- a logical byte that is set anytime an 
identifier has an associated VALUE CLAUSE; used primarily to 
recognize the occurrence of a PICTURE CLAUSE before the 
VALUE CLAUSE or when a record entry has a VALUE CLAUSE, bdut 
no associated PICTURE CLAUSE except for those in its 
elementary field identifiers. 

VALUESLEVEL -- a byte value which saves the level number 
of a record identifier which doesn’t have an associated 


PICTURE CLAUSE. 
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APPENDIX E 
MACEINE DEPENDENT VARIABLES 


The NPS MICRO-COBOL compiler/interpreter is designed to 
overate on any 80&0 or Z8&d based microcomputer overating 
under CP/M with at least 2@k bytes of memory. The PLM8@ 
source files have been written in such a way, that certain 
variables must be altered in the source code to take 
advantage of the machine that the programs are going to be 
operating on. This appendix covers those programs and the 
variables that must be altered. 

ieeART1. PLM 

This program has two variables that are memory size 
dependent, MAXSMEMORY and MAXSINTSMEMORY. The variable 
MAXSMEMORY is set to 1888 bytes below the base of the EDOS 
and is used for the beginning address of the IREADER 
routine. The variable MAXSINTSMEMORY is set to the base 
address of the BDOS and is used as the upper lirit for the 
fitermediate code file. 

Pee PARTZ. PLM 

This program also has two variables that are memcry size 
dependent, MAXSMEMORY and PASS1STOP. In this program 
MAXSMEMORY is set to the dbase address of the BDOS while 
PASSISTOP is set to 190H bytes below the base of the BDOS. 

3. READER .PLM 


Although, this program does rot have any memory size 
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dependent variables the prograr must be modified to execute 
properly. When using the LOCATE command, under ISIS, this 
routine must be located 1308 bytes below the BDOS of the 
system. This address would correspond to the values of 
MAXSMEMORY in PART2.PLM and MAXSINTSMEMORY in PART1.PLM. 

4. BUILD.PLM 

This program has one memory size dependent variable, 
INTERPSADDRESS must be set to the same address as CODESSTART 
Pein TERP. PLM. 

3. INTERP.PLM and INTRDR.PLM 

These two programs have no variables that need to be 
altered. 

6. GENERAL INFORMATION 

The current version of the NPS PIC ROS COR On 
compiler/interpreter is designed for continued development 
and certain variables are not set to make optimal use of 
memory. The variable NEXTSAVAILABLE, in PART1.PLM, is set to 
Seeed and CODESSTART, in INTERP.PLM, is set to 35008. 
Normally, CCDESSTART would be set to the address immediately 
following the last address in CINTERP.COM and NEXTSAVAILABLE 
would be set two bytes above that address. These address are 
currently set approximately 45@H bytes above where they 
Should be located, to allow for testing and expansion of the 
interpreter. AS soon as implementation is completed these 


two addresses can be reset to aporopriate values. 
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APPENDIX F 
MICRO-COBOL PARSE TABLE GENERATION 


mmemeparse tables for NPS Micro-Cobol were generated on 
the IEM 360 using the LALR(1) parse table generater 
described in reference 2@. There are basically two steps 
involved in generating the tables. First, a deck of cards 
containing the grammar is entered into the computer using 
the following JCL: 
//PROGNAME JOB (2320,0417,CS91), optional data’, TIME=5 
//GO EXEC PGM= LALR,REGION=22@K 
//STEPLIB DD DSN=FO119.LALR ,UNIT=2314, 
VOL=SER=LINDA ,DISP=SEHR 
//SYSPRINT DD SYSOUT=A,DCB=(RECFM=FB, 
LRECL=133 , BLXSIZE=3325), 
my SPACE=(CYL,(1,1)) 
//NONTER” DD SPACE=(CYL,(1,1)),UNIT=SYSDA 
//¥SMDATA DD SPACE=(CYL,(1,1)),UNIT=SYSDA 
* //PTABLES DD SYSOUT=B, 
DCB=(RECFM=FB,LRECL=80 , BLKSIZE=8@@) 
P7SiSIN DD * 


* This card can be replaced by //PTABLES DD SYSOCUT=DUMMY 
to surpress the card punching feature. This allows 
modifications to be made without wasting cards until 


a new LALR(1) grammer is produced. 
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MiemOuUpUtLet rom toils rum is @ listing and a card deck 
containing the tables in XPL compatable format. This deck is 
then translated into PLM compatible format using the 
following JCL and an XFL program which is available in the 
card deck library in the Computer Science Department at the 
Naval Postgraduate School. 

//EXEC XCOM 

PPCOMP .SYSIN DD * 

V7G0O.91SPUNCH DD SYSOUT=B, 

DCB=(RECFM=FEB,LRECL=8¢,BLKSIZE=820) 

fee. oYSIN DD * 

The tables are then transferred to a diskette and edited 
mero tune PLM89 source program using the ISIS COPY and EDIT 
features on the INTEL MDS System. See APPENDIX H for the 
procedures to transfer files from the IBM-S6@ to a floppy 


diskette. 
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APPENDIX G 
LIST OF INOPERATIVE CONSTRUCiS 


The following is a list of MICRO-COBOL elements that 
either have not been implemented. 

SeOsck —- multiple closes 

OPEN - multiple open’s 

The following HYPO-COBOL elemerts are part of NPS 
MICRO~-COBOL only to the extent that they are defined in the 
grammar. No code has been written to support them. 

COMPUTE 

AND and OR 

ENTER 

COMP and COMPUTATIONAL (binary arithmetic storage and 
operations) 

INDEXED 


MULTI-DIMENSION tables 
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APPENDIX 48 
IBM TO MICROCOMPUTER TRANSFER PROCEDURES 


A CP/M operating system program was written by Prof. 
Kodres for the express purpose of transferring ASCII files 
from the IBM CP/CMS system. In order to use this preegran, 
several equipment requirements must be met: a.) Reserve the 
appropriate Intel MDS system in the Microcomputer Lab. b.) 
Call 646-2721 (computer-center) to reserve a high speed(122@ 
baud) line to the micro-lab. c.) Connect the line marked 
"IBM 1202 BAUD line to the “black box marked IBM, which 
Moemtains line drivers for the RS-2S52 circuit. Check that the 
toggle switch is in the up/raised position. ad.) Connect the 
serial connector coming off the MODIFIED single board 
Computer (marked with a yellow dot) to the other end of the 
memenariver box. All of the other boards in the MDS are 
unmodified with the exception of times when <Hagaitare 
experimentation is being conducted by various groups of 
Students and/or facalty. 

To commence communication with the 36@ - invoke the CP/M 
program IBM.COM - an executible file. The program is loaded 
and executed by typing “IBM filename.filetype , where 
“filename.filetype is selected by the user as the CP/M file 
which will be created as a result ofa file transfer. 
Successful completion of the above steps will result in the 


following data being displayed on the CRT: 
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(crt echo? y/n) Answer y. 
(n) Placed by the CP/M program 
Enter a <CRD> 

caCP-67 Online Normal CP/CMS signon ressage 

At this point login to CP/CMS in a normal manner. Files 
are transfered using the CMS command PRINT followed by the 
mame of the file to be transfered followed by a control-R. 
This will cause the MDS to be put into the receive mode. A 
Meip Will start the file transfer. The CRT should display 


the following for a successful file transfer. 


PRINT cmsfilename cmsfiletype Enter a control-F 

(R) Puts MDS in receive mode 
(R. CREATED filename.filetype) Enter a <CR> 

(---- bytes received END R) Enter a <CR> to re-enter CP 


Wnter a control-C to reboot 


Each file transfer must be done with a separate 
mayocation of the IBM file as all files will be transfered 
to the file named when IBM is invoked. Before rebooting for 
the last time logout of CP/CMS in the normal manner and call 
2721 and inform the computer center that the high speed line 


is available for other user’s. 
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APPENDIX I 
DEBUGGING NPS MICRO-COBOL USING SID 


Notes Steps two and three are optional. They are used if 
the line numbers in the program listing are to be 


used as well as the symbols for pass points. 


PART ONE. 


meeoib> COBOL.COM PARTI .SYM 
- II* PART1.LIN 
R <ret> 


I<file name.C3L> S<compilier toggles as required> 


no fF WA WW 


- set desired passpoints 


PART TWO. 


mee ol) COBOL.COM PART2.SIM 

oe I PART2.LIN 

So. R<ret> 

4. i<file name.CBL> $<compilier toggles as required> 


oi 86L Oe 

6. G,ORIGd 
i 100 

8. ¢,1¢@¢ 


9. Set desired passpoints 
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INTERPRETER. Note: Use only SYM or LIN files but not both. 


ieeeolD BREC.COM CINTERP.SYM 
2. I* CINTERP.LIN 

2. R<ret> 

4. I<file name.CIN> 


Be. G,22k 

ee. T25 

me &,100 

8. Set desired passpoints 


These instructions are designed to get the programs to the 
proper place to be able to use SID. See reference [8] for 
instructions on how to use SID commands. It should be noted 
that changes to the routine BUILD will change instruction & 
in the INTERPRETER command list. That command is intended to 
stop after BUILD has finished executing and is the location 


of the last instruction in that module. 
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COMPUTER LISTING FOR MODULE PART ONE NPS MICRO-C23RBOL 


$ TITLE(°NPS MICRO-COBOL COMPILER PART1”) PACEWIDTE(8@) 


PAGELENGTH (6) 
PART1:DO3 
po COBOL COMPILER -— PART 1 a7 
Ls NORMALLY LOCATED AT 193H ay, 
/* GLOBAL DECLARATIONS AND LITERALS a7 


DECLARE DCL LITERALLY “DECLARE”, 


LIT LITERALLY 


“LITERALLY”; 


meL CR Teter eS a: 
EOFFILLER ee “1AH°, /* END OF RECORD FILLER */ 
FALSE 1 Cie 
FRROR BYTE INITIAL(FALSE), 
FILESDESCSFLAG BYTE INITIAL(FALSE), 
UISFLAG BYTE, /*UNDRECLARED VAR FLAS*/ 
FOREVER Ieee "WHILE TRU®’, 
INITIALSPOS ADDRESS INITIAL(3600H), 
LF ieree Bee 
MAXSMEMORY ADDRESS INITIAL(@B20GE), 
QUOTE ier Soe. 
PARMLIST(9) BYTE INITIAL( 7 ce 
PARMS foie “6DE’, 
PASSISLEN ADDRESS INITIAL(352), 
POUND er Ooh 
PROC Gir “PROCEDURE’, 
RDRSLENGTH Lit 72557 | 
TRUE ee oi; 
DCL MAXLNO LITERALLY °138°, /* MAX LOOK COUNT */ 
MAXPNO LITERALLY °1586’%, /* MAX PUSH COUNT */ 
MAXRNO LITERALLY “110°, /* MAX READ COUNT */ 
MAXSNO LITERALLY °253°, /* MAX STATE COUNT */ 
STARTS LITERALLY “17, /* START STATE */ 
PRODNO LITERALLY °97°, /* NUMBER OF PRODUCTIONS */ 
PROCC LITERALLY “487, /* PROCEDURE */ 
TERMNO LITERALLY °64°3; /* TERMINAL COUNT */ 
DCL READ1 (*) BYTE 


fens 6) , 20 ,68,35,8,25,65,2 ,35,59,62,11,33,353,41,40.36 
for, 19 ,59,6,26,54,59,5,14,15,18,28@,33 ,29,51,35,1 ,44,40 
Memo yl y+,1,21,51,1,1,1,1,19,1 ,41,1,1,1,46,1,35,42,51,40 
meee, 1, 20,16,17,22,50,25,24,598,94,97 ,45,57,48,1,7,52,1 
Bey Oe 50D 9 Hl 1 S041 OS ot SO ol 509 49,27 Sy 09 hy SOO 
Mee, 1 oo,5,12,13,21,22,28,1 ,64,1,25,24,58,61,53); 
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DCL LOOK1(*) BYTE 
DATA(G,8,0,25,8,9,19,0,44,9,44,0,1,9,54,8 ,57,9,43,0,37,0 
meee o49 014 ,0.55,9,56,9,42,9,1,0,2,89,55,9,1,8,1,8,11 
,2,64,9,7,8,33,0,33,8,35,08);3 

DCL APPLY1(*) BYTE 
TATA(G,0,0,09,0,0,0,0,9,10,12,14,16,28,2,0,9,2,09,9,1297,9,2 
,126 ,0,0,09,8 ,0,0,123,8,28,9,8,8,9,98,09,9,9,96,0,9,8,2,13 
,18,%,108,199,118,9,3,9,8,8,181,8,8,56,9,0,24,31,39,49,0 
,22,41 ,42,54,58,98,99,1898,9)$3 

DCL READ2 (*) BYTE 
DATA (2,68,59,67,168,27,38,72,22,252,63,69, 28,253,231 ,523 
647 114,115 , 242,243 ,45,232 ,233 ,235,234,23, 249,248,251 , 2508 
Bere 80.188 ,184,9,245,49,212,211 ,7,8,11,13,18,2,3,111 ,16 
Miles 4 ,52,21,14,19,50,12,187,186,185,46,51,20,18,48,31,32 
, 34,48 ,36 ,27,66,62,65,55,44,157,17,26,68,112,169 ,168,169 
, 169,57 ,162,169,164,169,166 ,169,172 ,169,58,224, 2&2, 2a9 
, 24,42 ,64 54,222,196, 253 ,25,29,113,33 ,35,59,18,71,179,36 
, 37,66 ,41,61 )$ 

DCL LOOK2(*) BYTE 
DATA(ZG,5,139,6,143,30,309,141 ,43,142,56,143,144,72,74,145 
,75,146,76,147,77, 148,81 ,149 ,158 ,84 ,89 ,151 ,92,214,93 ,239 
,94,152,95,153 ,205,96,98,298 ,99,213 ,227,181,154,182,183 
,192,195,155,156,197,1096,216,199,216,119, 284); 

DCL APPLY2(*) BYTE 
DATA(@,@,121 ,158,118,117,119,159 ,83 ,122 ,85,86,87 ,88,82,80 
,126,79,170 ,135,178,177,126,181,189 ,182 127,183 ,175,133 
»195,194,100 ,130,78,134,129 ,2@3 ,202 ,104,128,288, 287 ,218 
meee. 199 137,158,156, 221 ,221,221, 228 ,123,132,97,131,239 
, 229,249,237 ,236,241,215,91,125,124,98,116,73,238,190,225 
,223 ,198,198,197); 

DCL INDFX1(*) BYTE 
mene 1 2,3 ,4,5,6,7 eer 4,459 oh, 9 e4,10,4,11,9,117 .4,12,13 
ono ,14,15,16,13,17,19,9,21,22,26,27, 02, 3%4,25,9,9,13,13 
06,37 28,49 ,41 ,42,43,44,45,46 ,47,13,48,26,49,135 ,50,51 82 
53, 54,55,56,57,60,61,62,63 ,64,65,69, 72,73, 74,75,76,77 ,78 
»79 88,82 ,84,86,88,98,92,94,95,97,98,99,198,181,65,192,8 
e195 ,175 ,105,12,111,112,113 ,117,9,9,9,1,23,5,8,198,12 
,14,16,18,20,22, 24, 26,28,30,32,34,36,38,40,42 ,44 ,46,48,52 
»52,54 ,56 ,201,161, 244, 246, 246, 206 ,165 ,163 ,167, 219,171,174 
Bo 176,191 ,228, 217,195 ,1 , 2 od oF 94 9 95 8 eG 25 758 98 915515 
»16,17,17 ,18,18,19,19, 28, 22, 22 ,23 ,23,23,25,25,25,26,26,27 
927 528 428 29,29 30,32, 52 54,35 435 36,36 ,37,39,29 40,40 ,41 
941,41 41 ,41,43,43,44,44,45,45 46 ,46,49,53,53,54 54,65 ,55 
56 ,56,57,57,57,57,57 57 57 57 657 ,57,57 ,59,59,59,60,68,62, 
,62,62,62 ,62,63,68);3 

DCL INDFX2(*) BYTE 


Boe O51 ,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1.1,1,1,1,1,1,1,1,1 
cea) lyst geee.c,t,l,1,1,1,1,1,1,2,1,1,1,1,1,1.1,1 
wept pl eis slats lets, leo, 1 Peel gt yep els ly ll sd au rt 
Men eee ye, l,l, isl,l,4,1,1,1,2,6,6,1,1,1,4,2,1,1 
ME OI OS, Cy Coo 9 Sok hy leh lsc sky eye egerh ye 





9G OO 545,56, 72,74,75,76,77 1 ,84,89,94,9& 192,185,187 
Nemec one sent yo70,o,2,2,1,°,0,98,1,0,6,8,9.1,5,89,1,1,2,1 
Beer 0.25070 ,1,2,0,1,9,0,09,9,1 Rag Cae plage psc —e 
Reo CoC. 1. 4,8,8,1,8,08,9 Solel lelslelsleeedelyt 
5158,8,9,8,8,0,9,0,0,0,9,8)3 
/* JOINT DECLARATIONS 
TEESE ITEMS ARE DECLARED TOGETHER IN THIS SECTION 
IN ORDER TO FACILITATE THEIR BEING SAVED FOR 
THE SECOND PART OF THE COMPILER. */ 
DCL DERUGGING BYTE INITIAL(FALSE), 
ERRORSCTR(5) BYTE INITIAL( “ 2 
LINESCTR(5) BYTE, 
LISTSBUFF(128) BYTE, 
meee ote BYTE INITIAL(@,~ LST’ ,2,2,2 
»o ? 
LISTSINPUT BYTE INITIAL(TRUE), 
LISTSPTR ADDRESS, 
MAXSINTSMEM ADDRESS INITIAL(@B10@), 
NEXTSAVAILABLE ADDRESS INITIAL(35@24), 
NEXTSSYM ADDRESS, 
NOSCODE BYTE INITIAL(FALSE), 
OUTPUTSBUFF (128) BYTE, 
me Os FoR(S3) BYTE INITIAL(Q, “ CIN’ ,@,2,2 
OL) 
OUTPUTS PTR ADDRESS, 
POINTER ADDRESS INITIAL(1@0E), 
PRINTS PROD BYTE INITIAL(FALSE), 
PRINTSTOKEN GENS INITIAL(FALSE), 
SEQSNUM BYTS INITIAL(FALSE), 
WRITESLST BYTE INITIAL(FALSE), 
FREESSTORAGE ADDRESS INITIAL(38@0H), 
FILESSECSEND BYTE INITIAL( FALSE), 
/* 1 QO BUFFERS AND GLOBALS */ 
INSADDR ADDRESS INITIAL(SCE), 
INPUTSFCB BASED INSADDR(33) BYTR, 
LISTSCHAR BASED LISTSPTR BYTE, 
LISTSEND ADDRESS, 
OUTPUTSCEAR BASED OUTPUTSPTR BYTE, 
OUTPUTSEND ADDRESS; 


MONi: PROC (F,A) EXTERNAL; 
DCL A ADDRESS, F BYTE; 
END MON1; 


MON2: PROC (F,A) BYTE EXTERNAL; 


DCL F BYTE, A ADDRESS; 
END MON2; 


BOOT: PROC EXTERNAL; 


186 





END BOOT; 


PRINTSCEAR: PROC (CHAR); 
DCL CHAR BYTE; 
CALL MON1 (2,CHAR); 
END PRINTCEAR; 


WRITESOUTPUT: PROC(BUFF,FCB); /* WRITES OUT A BUFFER */ 
DCL (BUFF,FCB) ADDRESS; 
CALL MON1(26,BUTF); /* SET DMA */ 
IF MON2(21,FCB) <> @ TEEN 
DO; 
CALL MON1(9,.(°WRS’))5 
CALL BOOT; 
END$ 
CALL MON1(26,80E); /® RESET DMA *%/ 
END WRITESOUTPUT; 


WRITESTOSDISK: PROC(CHAR); 
DCL CHAR BYTE; 
IF (LISTSPTR s= LISTSPTR + 1) > LISTSEND THEN 
DO; 
CALL WRITESOUTPUT( .LISTS3UFF, .LISTSFCR); 
LISTSPTP = .LISTSBUFF; 
END; 
LISTSCHAR = CHAR; 
END WRITESTOSDISK;3 


PRINT: PROC (A)3 
DCL (A,ADDR) ADDR ESS,CHAR BASED ADDR BYTE; 
ADDR = A3 
DO WHILE CHAR <> %$73 
CALL WRITESTOSDISK(CHAR); 
ADDR = ADDR + 13 
END} 
CALL MON1 (9,A)3 
END PRINT; 


CRLF: PROC; 
GALL MON1(9,.(CR,LF,°$’));3 
END CRLF; 


DCRLF: PROC; 
CALL WRITESTOSDISK(CR); 
CALL WRITESTOSDISK(LF); 
END DCRLF; 


INCSCTR: PROC(BASE);$ 
DCL BASE ADDRESS, CTR BYTE, BSBYTE BASFD BASF (1) RYTE, 
TEN LIT °’SAH’$ 
err = 43 
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DO WRILE (BSBYTE(CTR) Joop rm (crTR) + 1) = TEN; 
BoRYOIN( CTR 2 3 
IF CTR D @ aa 
IF BSBYTE(CTR := CT 
BSBYTE(CTR) = ” 


1) = ° ° THEN 


END; 
END INCSCTR; 


PRINTSERROR: PROC (CODE); 
DCL I BYTE,CODE ADDRESS,CODE1(6) ADDRESS; 
Ir CODE = FALSE THEN 
DQ; 
DO I = @ TO 5; 
CODEI(I) = @; 


END; 
nc, 
END; 
ELSE IF CODE = TRUE THEN 
DO; 
iil; 
DO WHILE((I <> 6) AND ( CODFI(I) <> @))3 
CALL PRINTCHAR(HIGH(CODE1(1)))3 
CALL PRINTCRAP(LOW (CODE1(I1)))3 
CALL WRITESTOSDISK(EIGH(CODE1(I)))3 
CALL WRITESTOSDISK(LOW (CODEFi(I)))3 
CALI CHE, 
CALL , 
CODE1(I) = 
I = 1] + 1; 
END; 
f= or 
ERROR = FALSE} 
END} 
mse IF (CODE = “NP’) OR (CODE = “SL’) 
OR (CODF = ’NV’) TREN 
DO; 
ERROR = TRUE; 
CALL PRINTCHAR(FIGH(CODE) ) 
CALL PRINTCHAR(LOW(CODE) )3 
CALL INCSCTR(.EPRORSCTR(@))3 
IF CODE <> “NP” THEN 
DO; 
CALIEORE 
CALL DCRLF; 
END; 
END} 
ELSE 
DO} 


ERROR = TRUE; 
Ir I <> 6 THEN 
LO; 
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CODE1(I1) 
I =I + 


END; 
CALL INCSCTR(.ERRORSCTR(O)); 
END; 
END PRINTSERROR} 


FATALSERROR: PROC(REASON); 
DCL REASON ADDRESS; 
CALL PRINTSFRROR(REASON)3 
CALL PRINTSERROR(TRUE); 
CALL BOOT; 

END FATALSFRROR; 


OPEN: PROC; 
IF MON2 (15,INSADDR) = 255 THEN CALL FATALSERROR( OP”); 
END OPEN; 


MORESINPUT: PROC BYTE; 
DCL DCNT BYTE} 
IF (DCNT := MON2(28,.INPUTSFCB)) > 1 THEN 
CALL FATALSERROR( “BR’); 
RETURN NOT(DCNT);3 
END MORESINPUT; 


MAKE: PROC(FCB); 
DCL FCB ADDRESS; 
/* DELETES ANY EXISTING COPY OF THE OUTPUT FILE 
AND CREATES A NEW COPY*/ 
CALL MON1(19,FCB); 
IF MON2(22,FCB) = 255 THEN CALL FATALSERROR( ‘MA’ ); 
END MAKE; 


MOV®: PROC(SOURCE, DESTINATION, COUNT); 
DCL (SOURCE,DESTINATION,COUNT) ADDRESS, 
(SSBYTE BASED SOURCE, DSBYTE BASED DESTINATION) BYTE; 
DO WHILE (COUNT := COUNT - 1) <> @FFFFH; 
DSBYTE = SSBYTE; 
SOURCE = SOURCE + 13 
DESTINATION = DESTINATION + 13 
END; 
END MOVE} 


FILL: PROC(ADDR,CHAR,COUNT); 
DCL (ADDF,COUNT) ADDRESS, 
(CHAR,DEST BASED ADDR) BYTE; 
DO WHILE (COUNT := COUNT - 1) <> @FFFFH; 
DEST CHAR; 
ADDR ADDR + 1; 


END; 
END FILL; 
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es Pe ee ee CGANNER LITS ££ = *  *x/ 


DCL INPUTSSTR LIT woe, 
LITERAL Der BS. 
PERIOD LIT a 


/*# *% *% * * SCANNER TABLES * * * * 8 */ 

DCL TOKENSTABLE (*) BYTE DATA 
/* CONTAINS THE TOKEN NUMBER ONE LESS THAN THE FIRST 
PRESFRVED WORD FOR BACH LENGTH OF WORD #*/ 
(2,0,1,4,5,15,22,33,48,46,49 ,51,53,58,60,61), 


[eebe(*) BYTE DATA( FD’, OF’,°TO’, PIC’, COMP’, DATA’, FILE’ 
moreet~, MODE’, SAME , SIGN’ ,°SYNC’,°ZERO’, BLOCK’ 
, LABEL’, ‘QUOTE’, “RIGHT’,° SPACE’, USAGE’, VALUE’, “ACCESS ” 
, ASSIGN’, AUTHOR’, “COMP-3°, “FILLER’, “OCCURS”, “RANIOM’ 
, RECORD’, ° SELECT’, ‘DISPLAY’, “INDEXED”, “LEADING” 
MebINKAGE ,» OMITTED’ , RECORDS’ ,°SFCTION’, “DIVISION” 
, RELATIVE’, “SECURITY”, “SEPARATE’, “STANDA2D’, “TRAILING ’ 
» DEBUGGING’, PROCEDURE’, “REDFFIN®S”, “PROGRAM-ID’ 
, SEQUENTIAL’, ENVIRONMENT’ , I-O-CONTROL’, “DATF-—WRITTEN’ 
, FILE-CONTROL’, ‘INPUT-OUTPUT’, INSTALLATION’ 
» ORGANIZATION’, “COMPUTATIONAL’, “CONFIGURATION 
, IDENTIFICATION’, OBJECT-—COMPUTER’ , SOURCE-COMPUTER’ 
, WORKING-STORAGE’), 


OFFSET (16) ADDRESS 
/* NUMBER OF BYTES TO INDEX INTO THE TABLE FOR FACH 
LENGTH */ 
INITIAL (8,8,0,6,9,45,88,124 ,182 ,231 ,258,278, 
300,368 ,366,402), 


WORDSCOUNT (*) BYTE DATA 
PoONUMBER OF WORDS OF EACH SIZE */ 
Mem 19, 7 594 610s eee eeel ESe) 


ACCUMSLENSP$1 LIT 751°, /* ACCUMSLENG PLUS 1 */ 
ACCUM (ACCUMSLENSP$1) BYTE, 

ACCUMSLENG ir "50", 

ADDSEND(*) BYTE AeA PROCEDURE’), 
BUFFERSEND ADDRESS INITIAL(1@@H), 

CHAR BYTE INITEAL(CR), 

DISPLAY(&8) BYTE PNTRMeGK 5S. © 1°), 
FIRSTSLINE BYTE INITIAL(TRUE), 

FORMSFEED LIT “OCH’, 

HOLD RYTE, 

INBUFF iat 80H’, 

LOOKED BYTE INITIAL(FALSE), 

MAXSLEN LT Sie 

NEXT BASED POINTER BYTE, 

TAB Ted "39°, 
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TOKEN BYTE; /*RETURNED FROM SCANNER */ 
ar Oe PROCEDURES USED BY THE SCANN@R * * * ¥/ 


NEXTSCHAR: PROC BYTE; 
IF LOOKED THEN 
DO; 
LOOKED = FALSE; 
RETURN (CHAR := EOLD); 
END; 
IF (POINTFER:=POINTER + 1) >= BUFFERSEND THEN 
DO. 
IF NOT MORESINPUT THEN 
DO; 
RBUFFERSEND = .MEMORY; 
POINTER = .ADDSEND; 
END; 
ELSE POINTER = INBUFF; 
END; 
IF NEXT = EOFFILLER THEN 
DO; 
BUFFFRSEND = .MEMORY; 
POINTER = .ADDSEND; 
END} | 
RETURN (CHAR := NEXT); 
END NEXTSCHAR; 


GETSCEAR: PROC; 
CHAR=NEXTSC HAR; 
END GETSCEAR; 


DISPLAYSLINE: PROC; 
bo 4 4€6f «€BYTE; 
bol = 1 TO DISPLAY(@); 
IF LISTSINPUT OR ERROR THEN CALL 
PRINTCHAR(DISPLAY(1)); 
IF WRITESLST OR ERROR THEN 
CALL WRITESTOSDISK{ DISPLAY(1)); 
END; 
CALL INCSCTR(.DISPLAY(2)); 
DISPLAY(@) = 5; 
END DISPLAYSLINE; 


LOADSDISPLAY: PROC; 
IF DISPLAY(@) < 8? THEN 
DISPLAY(DISPLAY(@) := DISPLAY(@) + 1) = CHAR; 
CALL GETSCHAR; 
END LOADSDISPLAY; 


mr: PROC; 
IF ACCUM(@) < ACCUMSLENG THEN 
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ACCUM(ACCUM(@) := ACCUM(@) + 1) = CHAR} 
CALL LOADSDISPLAY; 
END PUT; 


EATSLINE: PROC; 
DO WHILE CHAR <> CR; 
CALL LOADSDISPLAY; 
END; 
END EATSLINE; 


GETSNOSBLANK: PROC} 
bol I BYTE; 
DO FOREVER; 
[fe CHAR = OR CHAR = TAR) THEN CALL LOADSDISPLAY; 
ELSE IF CHAR=CR THEN 


DO; 
IF FIRSTSLINE THEN 
CO; 
FIRSTSLINE = FALSE; 
CALL GETSCHAR; 
END; 
ELSE 
DO; 


CALL LOADSDISPLAY;} 
CALL LOADSDISPLAY} 
CALL DISPLAYSLINE; 
CALL PRINTSERROR(TRUE): 
END; 
DO WHILE CHAR = CR; 
CALL LOADSDISPLAY; 
CALL LOADSDISPLAY; 
CALL DISPLAYSLINE; 
END} 
IF SEQSNUM THEN 
DO I = 1 TO 6; 
CALL LOADSDISPLAY; 
END; 
IF CHAR = °*° THEN CALL EATSLINE; 
ELSE IF CHAR = ’/’ THEN 
DO; 
IF LISTSINPUT THEN 
CALL PRINTSCHAR(FORMSFEED)} 
IF WRITESLST THEN 
CALL WRITESTOSDISK (FORMSFEED) ; 
CALLE EAXTBINE 
END; 
ELSE IF CHAR = “:” THEN 
DO; 
IF NOT DEBUGGING THEN CALL SATSLING; 
ELSE CALL LOADSDISPLAY; 
END; 
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END; 
ELSE RETURN; 
END; /* END OF DO FOREVER */ 
END GETSNOSBLANKX; 


SPACE: PROC BYTE; 
RETURN (CHAR = “ “) OR (CHAR = CR) OR (CEAR = TAB); 


END SPACE; 


DELIMITER: PROC BYTE; 
IF CHAR <> °.° THEN RETURN FALSE; 
EFOLD = NEXTSCHAR; 
LOOKED = TRUE; 
IF SPACE THEN 


DO; 
CHAR = °.%3 
RETURN TRUE} 
END; 
SHAR = °.°3 


RETURN FALSE; 
END DELIMITER; 


ENDSOFSTOKEN: PRCC BYTE; 
RETURN SPACE OR DELIMITER; 
END ENDSOFSTOKEN; 


GETSLITERAL: PROC BYTE; 
CALL LOADSDISPLAYs 
DO FOREVER; 
IF CHAR = QUOTE THEN 
DO; 
CALL LOADSDISPLAY; 
RETURN LITERAL; 
END; 
CALL PUT; 
END; 
END GETSLITERAL; 


BOOKSUP: PROC BYTE; 
DCL POINT ADDRESS,HERE BASED POINT(1) BYTE, I BYTE; 


MATCH: PROC BYTE; 
DCL J BYTE; 
DO J =1 TO ACCUM(G); 
IF HERE(J - 1) <> ACCUM(J) THEN RETURN FALSE; 
END; 
RETURN TRUE; 
END MATCH; 


POINT = OFFSET(ACCUM(@)) + . TABLE} 
DO I = 1 TO WORDSCOUNT(ACCUM(@)); 
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IF MATCH THEN RETURN I3 
POINT = POINT + ACCUM(@)3 
RIND $ 
RETURN FALSE; 
END LOOKSUP3; 


RESERVEDSWORD: PROC EYTE; 
DCL (NUMB,VALUE) BYTE; 
IF ACCUM(@) > MAXSLEN THEN RETURN @; 
IF (NUMB := TOKENSTABLE(ACCUM(@))) = @ THEN RETURN @; 
IF (VALUE := LOOKSUP) = @ THEN RETURN @; 
RETURN (NUMB + VALUE)3 
END RESERVEDSWORD; 


GETSTOKEN: PROC BYTE; 
ACCUM(@) = 3 
CALL GETSNOSBLANK; 
IF CHAR = QUOTE THEN RETURN GETSLITERAL; 
IF DELIMITER TEEN 
DO; 
CALL PUT; 
RETURN PERIOD; 
END; 
DO FOREVER; 
CALL PUT; 
IF ENDSOFSTOKEN THEN RETURN INPUTSSTR; 
END; /* OF DO FOREVER */ 
END GETSTOKEN; 


SCANNER: PROC; 
DCL CHECK BYTE; 
DO FOREVER} 
IF(TOKEN := GETSTOKEN) = INPUTSSTR THEN 
IF (CHECK := RESFRVEDSWORD) <> @ THEN 
MOKEN@= CHECK? 
IF TOKEN <> @ THEN RETURN; 
CALL PRINTSERROR (°SE’);3 
DO WHILE NOT ENDSOFSTOKEN} 
CALL GETSCHAR; 
END; 
END; 
END SCANNER} 


PRINTSACCUM: PROC; 

Do, I BYTE; 

DO I = 1 TO ACCUM(@); 
CALL PRINTSCHAR(ACCUM(I))3 
CALL WRITESTOSDISK(ACCUM(I1))3 

END; 

eabL CRLF; 

CALL DCRLF;3 
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END PRINTSACCUM; 


PRINTSNUMBER: PROC(NUMB)3 
DCL(NUMB,I,CNT,K) BYTE, J(*) BYTE DATA(10@,1@); 
mot = @ TO 1; 

CNT = 0; 
DO WHILE NUMB D= (K := J(1));3 
NUMB=NUMB — K3 
CNT=CNT + 13 
END; 
CALL PRINTCHAR(°@° + CNT); 
END; 
CALL PRINTCHAR(‘°Q” + NUMB);3 
END PRINTSNUMBER; 


INITSSCANNER: PROC} 
DCL CONSCBL (*) BYTE DATA ( “CBL’), (TESTFLAG,1) BYTE; 
CALL ee ee etsT &); 
IF PARMLIST(@) = “ TREN 
DO; 
z I = 8; 
DO WHILE (TESTFLAG — PRIME ISR Cle= Tere yi * “3 
IF TESTFLAG °“L’ THEN LISTSINPUT NOT LISTSINPUT; 


IF TESTFLAG = °S” THEN SEQSNUM = NOT SEQSNUM; 

IF TESTFLAG = °P” TEEN PRINTSPROD = NOT PRINTSPROD; 
IF TESTFLAG = “T° THEN PRINTSTOKEN = NOT PRINTSTOXEN; 
IF TESTFLAG = “C”° THEN NOSCODE = NOT NOSCODE; 

IF TESTFLAG = “W° TEEN WRITESLST = NOT WRITESLST; 
IF TESTFLAG = “D’ THEN DEBUGGING = NOT DEBUGGING; 

END; 
END; 


CALL MOVE(.CONSCBL,INSADDR + 9,3)3 
CALL FILL(INSADDR + 12,98,5)3 
CALL OPEN; 
IF NOT NOSCODE THEN 
DO; 
CALL MOVE(INADDR, .OUTPUTSFCE,9)3 
CUTPUTSmCB(22) = @; 
OUTPUTSEND = (OUTPUTSPTR := .OUTPUTSBUFF - 1) + 128; 
-— MAKE( .OUTPUTSFCB); 
9 
CALL MOVE(INADDR,.LISTSFCB,9);3 
ProTSFCE(32) = @3 
iets END = (LISTSPTR s= .LISTSBUFF -— 1) + 128; 
CALL MAKE(.LISTSFCB);3 
CALL GETSNOSBLANK; /* PRIME THE SCANNER */ 
CAL L PRINTS ERROR (FALSE) $ 
CALL PRINT(.(’ NPS MICRO-COBOL COMPILER VERSION 2.0’ 
OR, Lr,LF,°$ )); 
END INITSSCANNERS 
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/* * ~*~ UK 


fe ** K ® 


DCL 

ADDR2 
CURSSYM 
DSCNT 
DECIMAL 
DISPLACEMENT 
ELSCNT 
HASHSMASK 
LEVEL 
LOCATION 
MAXSIDSLEN 
NEXTSSYMSENTRY 
OCCURSSPTR 
PSLENGTH 
RELSID 
SAVESADDR 
SSLENGTH 
SSTYPE 
STARTSNAME 
SYMBOL 
SYMBOLSADDR 
TEMPS PTR 
TEMPSADDR 
TEMPSBYTE 


——_— ~*« « 


DCL 

COMP ly 
GROUP LIT 
OCCURSSTYPE LIT 
RANDOM LIT 
RELSKEY yes 
RELSKEYSUR LIT 
SEQUENTIAL Lie 
SEQSRELATIVE LIT 
URSMASK LIT 


VARIABLESLENG LIT 


/* ig a 


INITSSYMBOL: PROC 


/* INITIALIZE HASH TABLE AND FIRST COLLISION 
CALL FILL (FREESSTORAGE,8,132); 


END OF SCANNER PROCEDURES * * 


* 


xe 


SYMROL TABLE ROUTINES * * * 


9 
g 


Sr MeEOL TABLE TECLARATICNS * * * 


ver 
ADDRESS, 
BYTE, 
LIT 

ler 

ike 

it 

iy 

LIT 

caer 
BASED NEXTSSY™M 
ADDRESS 
Dak 

LIT 
ADDRESS, 
ee 

ir 

tpt 


“BASED CURSSYM(1) 


BASED CURSSYM(1) 
ADDRESS, 

BASED TEMPSPTR 
BASED TEMPSPTR 


x 


=/ 
a7 


? ? 


/®SYMBOL BEING ACCESSED*/ 


Slee 
a 

coe 

“SFH’, 

og 

[2 

CAS) cu 
ADDRESS, 
INITIAL(@), 
ee 
NES 
BYTE, 
ADDRESS, 


VEEL Sos 


ADDRESS, 
EYTE; 


Peet Gh eeRALS 4 Fee MR e / 


Coe ee 
6 
"128" 
ey 
25° 
ne 
"128 
“4 


’ 


ee ee ee ee) 


.» x 


NEXTSSYM = FREESSTORAGE + 1283 
NEXTSSYMSENTRY = @; 


END INITSSYMBOL$ 
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GETSPSLENGTH: PROC BYTE; 
RETURN SYMBOL(PSLENGTE); 
END GETSPS LENGTH; 


SETSADDRESS: PROC(ADDR); 
DCL ADDR ADDRESS; 
SYMBOLSADDR(LOCATION) = ADDR; 
END SETSADDRESS; 


GETSADDRESS: PROC ADDRESS; 
RETURN SYMBOLSADDR(LOCATION); 
END GETSADDRESS ; 


GETSTYPE: PROC BYTE; 
RETURN SYMBOL(SSTYPE) 3 
END GETSTYPE; 


SETSTYPE: PROC(TYPE); 
DCL TYPE BYTE; 
SYMBOL(S$TYPE) = TYPE; 
END SETSTYPE; 


ORSTYPE: PROC(TYPE); 

DCL TYPE BYTE; 

SYMBOL(SSTYPE) = TYPE OR GETSTYPE; 
END ORSTYPE; 


GETSLEVEL: PROC BYTE; 
RETURN SYMBOL(LEVEL)3 
END GETSLEVEL3 


SETSLEVEL: PROC (LVL); 
mer LVL BYTE; 
SYMBOL(LEVEL) = LVL; 

END SETSLEVEL; 


GETSDFCIMAL: PROC BYTE; 
RETURN SYMBOL(DEFCIMAL); 
END GETSDECIMAL; 


SETSDECIMAL: PROC (DC); 
DCL DEC BYTE; 
SYMBOL(DECIMAL) = DEC} 

END SETSDECIMAL; 


SETSSSLENGTY: PROC (HOWSLONG);3 
DCL HOWSLONG ADDRESS; 
SYMBOLSADDR(SSLENGTH) = HOWSLONG; 
END SETSSSLENGTH; 
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GETSSSLENGTH: PROC ADDRESS; 
RETURN SYMBOLSADDR(SSLENGTH); 
END GETSSSLENGTH; 


SETSADDR2: PROC (ADDR); 
DCL ADDR ADDRESS; 
SYMRBOLSADDR(ADDR2) = ADDR; 
END SETSADDR2; 


SETSTRLSSIZE: PROC(OCCUR); 
DCL OCCUR ADDRESS; 
SYMBOLSADDR(ELSCNT) = OCCUR; 
END SETSTBLSSIZB;3 


GETSTBLSSIZE: PROC ADDRESS; 
RETURN SYMBOLSADIR(ELSCNT) $ 
END GETSTBLSSIZE; 


SETSIOSADDRS: PROC; 
SYMBOLSADDR(LOCATION) = NEXTSSYM; 
SAVESADDR = CURSSYM; 

END SETSIOSADDRS; 


GETSPREVSOCCURS :PROC ADDRESS; 
DerroPTR = CURSSYM + STARTNAME + GETSPSLENGTH; 
RETURN TEMPSADDR; 

END GETSPREVSOCCURS; 


PROCESSSOCCURS: PROC; 
TEMPSPTR = NEXTSSYM3 
NEXTSSYM = NEXTSSYM + 33 
TEMPSADDR = OCCURSSPTR; /*SET PTR TO PREVIOUS OCCURS*/ 
CALL ORSTYPE(OCCURSSTYPE); 
TEMPSPTR = TEMPSPTR + 2; 
TEMPSBYTE = DSCNT; 
END PROCESSSOCCURS; 
/* * * * PARSER DECLARATIONS * * * = */ 


DCL 

COMPILING BYTE INITIAL(TRUE), 
HOLDSLIT(ACCUMSLENSP$1) BYTE, 

HOLDSSYM ADDRESS, 

IDSSTACK(1@) ADDRESS INITIAL(2), 
IDSSTACKSPTR BYTE INITIAL(Q@), 

INT rier “67°, /* INITIALIZE */ 
om, JX) BYIr. 

MP BYTE. 

MPP1 BYTE, 

NOLOOK BYTE INITIAL(TRUE), 
REDEF BYTE INITIAL( FALSE), 
REDEFSONE ADDRESS, 

REDEFSTWO ADDRESS, 


198 





PENDINGSLITERAL BYTE INITIAL(FALSE), 


PENDINGSLITSID ADDRESS, 

PSTACKSIZE re “40°, /* SIZE OF STACKS */ 
SCD it 729°, /* COLE START */ 
SP BYTE INITIAL(255), 

STATE BYTE INITIAL(STARTS), 
STATESTACK(PSTACKSIZE) BYTE, /* SAVED STATES */ 
TEMPSHOLD ADDRESS, 

TEMPSTWO ADDRESS, 

TRUNCSFLAG BLE INITIAL(TRUE), 
VALUE(PSTACKSIZE) ADDRESS, /* TRMP VALUES */ 
VALUESFLAG RYTE INITIAL( FALSE), 
VALUESLEVEL BYTE INITIAL(@), 

VARC(51) BYTE; /*TEMP CHAR STORE*/ 


ae = 6*6hCM CO PARSER ROUTINES * * *% *¥ ¥/ 


BYTESOUT: PROC(ONESBYTE); 
DCL ONESBYTE BYTE; 
IF NOSCODE THEN RETURN; 
IF (OUTPUTSPTR := OUTPUTSPTR + 1) > OUTPUTSEND THEN 
DO 
CALL WRITESOUTPUT( .OUTPUTSBUFF, .OUTPUTSFCE); 
OUTPUTSPTR=.OUTPUTSBUFF; 
END; 
OUTPUTSCHAR = ONESBYTE; 
END BYTESOUT; 


STRINGSOUT: PROC (ADDR,COUNT); 
DCL (ADDR,I,COUNT) ADDRESS, CHAR BASED ADDR BYTE; 
DO I = 1 TO COUNT; 
CALL BYTESOUT(CHAR) 3 
ADDR = ADDR+13 
END; 
END STRINGSOUT; 


ADDRSOUT: PROC(ADDR); 
DCL ADDR ADDRESS; 
CALL BYTESOUT(LOW(ADDR)); 
CALL BYTESOUT(HIGH(ALDR)); 
END ADDRSOUT; 


FILLSSTRING: PROC(COUNT,CHAR); 
DCL (1,COUNT) ADDRESS, CHAR BYTE; 
mol = 1 TO COUNT; 
CALL BYTESOUT(CHAR); 
END; 
END FILLSSTRING; 


STARTSINITIALIZE: PROC(ADDR,CNT); 
DCL (ADDR,CNT) ADDRESS} 
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CALL BYTEOUT( INT); 

CALL ADDRSOUT(ADDR); 

CALL ADDRSOUT(CNT); 
END STARTSINITIALIZ£E; 


BUILDSSYMBOL: PROC(LEN); 
DCL LEN BYTE, TEMP ADDRESS; 
TEMP = NEXTSSYM; 
IF (NEXTSSYM := .SYMBOL(LEN := LEN + DISPLACEMENT) ) 
> MAXSMEMORY THEN CALL FATALSERROR( ‘ST’); 
CALL FILL (TEMP,@,LEN); 
END BUILDSSYMBOL; 
MATCH: PROC ADDRESS; 
/* CHECKS AN IDENTIFIER TO SEE IF IT IS IN TEE SYMBOL 
TABLE. IF IT IS PRESENT, CURSSYM IS SET FOR ACCESS. 
OTHERWISE A NEW ENTRY IS MADE AND THE PRINT NAME 
IS ENTERED. ALL NAMES ARE TRUNCATED TO MAXSIDSLFN*/ 
DCL POINT ADDRESS,COLLISION BASED POINT ADDRESS, 
(HOLD: 1) BYTE; 
IF VARC(@) > MAXSIDSLEN 
. THEN VARC(@) = MAXSIDSLEN; /* TRUNCATE IF REQUIRED */ 
HOLD = @;3 
Moet = 1 TO VARC(@); /* CALCULATE HASE CODE */ 
FOLD = HOLD + VARC(I);3 
END; 
POINT = FREESSTORAGE + SHL((HOLD AND HASHSMASK),1); 
UISFLAG = FALSE} 
DO FOREVER; 
IF COLLISION = @ THEN 


DO; 
UISFLAG = TRUE} 
CURSSYM,COLLISION = NEXTSSYM; 
CALL BUILDSSYMBOL(VARC(2)); 
SYMBOL(PSLENGTH) = VARC(O); 
HOml — sl etOPVARC( oO), 

SYMBOL(STARTSNAME + I) = VARC(I)3 

END; 
RETURN CURSSYM3 

END; 

ELSE 
DO; 


CURSSYM = COLLISION; 
IF (HOLD := GETSPSLENGTH) = VARC(@) THEN 


DO; 
I = 1; 
DO WHILE 
SYMBOL(STARTSNAME + I) = VARC(I); 
IF (I := I + 1) > HOLD THEN 
RETURN (CURSSYM := COLLISION); 
END; 
END; 
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END; 
POINT = COLLISION; 
END; 
END MATCH; 


ALLOCATE: PROC(BYTESSREQ) ADDRESS; 
DCL (HOLD,BYTESSREQ) ADDRESS; 
HOLD = NEXTSAVAILABLE; 
IF (NEXTSAVAILAPLE := NEXTSAVAILABLE + BYTESSREOQ) 
> MAXSINTSMEM THEN 
CALL FATALSERROR( °MO”); 
RETURN HOLD; 
END ALLOCATE; 


DIGIT: PROC(CHAR) BYTE; 

DCL CHAR BYTE; 

RETURN (CHAR <= °9°) AND (CHAR >= °@”); 
BND DIGIT; 


SETSREDEF: PROC (OLD,NEW); 
DCL (OLD,NEW) ADDRESS; 
REDEFSONE = OLD; 
REDEFSTWO = NEW; 
REDEF = TRUE; 

END SETSREDEF; 


SETSCURSSYM: PROC; 
CURSSYM = IDSSTACK(IDSSTACKSPTR); 
END SETSCURSSYM; 


STACKSLEVEL: PROC BYTE; 
CALL SETSCURSSYM; 
RETURN GETSLEVEL; 

END STACKSLEVEL; 


LOADSLEVEL: PROC; 
DCL HOLD ADDRESS; 


LOADSREDEFSADDR: PROC; 
CURSSYM = REDEFSONE; 
HOLD = GETSADDRESS; 
END LOADSREDEFSADDR; 


IF IDSSTACK(@) <> @ THEN 
DO; 
IF VALUE(SP - 2) = © THEN 
DO; 
CALL SETSCURSSYM; 
HOLD = GETSSSLENGTY + GETSADDRESS; 
END; 
ELSE 
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DO; 
IF FILESSECSEND THEN 
DQ; 


’ 
IF IDSSTACK(IDSSTACKSPTR) <> FEDEFSONE 
TEEN 
DO 


? 
CALL PRINTSERROR( ’R17); 
REDEFSONE = IDSSTACK(IDSSTACKSPTR) $3 
END; 
END; 
CALL LOADSREDEFSADDR;3 
END; 
IF (IDSSTACKSPTR := IDSSTACKSPTR +1) > GS TEEN 
DO; 
CALL PRINTSERROR( “EL” );5 
IDSSTACKSPTR = 93 
END; 
END} 
ELSE HOLD = NEXTSAVAILABLE; 
CURSSYM,IDSSTACK(IDSSTACKSPTR) = VALUE(MPP1); 
IF (CURSSYMX>DOCCURSSPTR) AND (DSCNT<>@) THEN 
CALL PROCESSSOCCURS; 
IF (GETSLEVEL = 1) AND (NOT FILESSECSEND) THEN 
CALL SETSADDR2(SAVESADDR) 3 ; 
CALL SETSADDRESS (HOLD); 
END LOADSLEVEL; 


REDEFSORSVALUE: PROC; 
DCL (HOLD,HOLD1,TEMP) ADDRESS, 
(CHAR,LVLSNBR) EYTE; 
IF REDEF THEN 
DO; 
IF REDEFSTWO = CURSSYM THEN 
DO; 
HOLD = GETSSSLENCTH; 
LVLSNBR = GETSLEVEL; 
CURSSYM = REDEFSONE; 
IF HOLD <> (HOLD1 := GFTISSSLENGTE) TREN 
DO; 
IF (LVLSNBR = 1) 
AND (NOT FILESSECSEND) THEN 
DO; 
CURSSYM = SAVESADDR; 
CALL SETSTYPE(VARIABLESLENG) ; 
IF HOLD>HOLDI THEN 
CALL SETSSSLENGTH(FCLD); 
ELSE 


CALL SETSSSLENGTH(HOLD1); 
END; 


IF FOLD > HOLD1 THEN 
DO; 
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IF LVLSNER = 1 THEN 
TEMP = ALLOCATE(HOLD - HOLD1); 
ELSE 
DO; 
CALL PRINTSERROR( ’R2%)3 
CURSSYM = REDFFSTWO3 
CALL SETSSSLENGTH(HOLD); 
END} 
END; 
END; /* END IF HOLD <> */ 
END; /* END IF REDEFSTWO = CURSSYM */ 
END; /* END IF REFEF */ 
ELSE IF PENDINGSLITERAL = @ THEN RETURN; 
IF (PENDINGSLITSID<>IDSSTACKSPTR) OR VALUSSFLAG THEN 
RETURN} 
IF PENDINGSLITERAL <> @ THEN 
CALL STARTSINITIALIZE(GETSADDRESS,HOLD := 
GETSSSLENGTH) 3 
IF PENDINGSLITERAL > 2 THEN 
DO; 
IF PENDINGSLITERAL = 3 THEN CHAR = ’O° 
ELSE IF PENDINGSLITERAL = 4 THEN CHAR 
ELSE IF PENDINGSLITERAL = 5 THEN CHAR 
CALL FILLSSTRING(HOLD,CHAR); 
END} 
ELSE IF PENDINGSLITERAL = 2 THEN 
DO} 


a a 


$ 
QUOTE; 


it Il we 


IF HOLD <= HOLDSLIT(@) THEN 
CALL STRINGSOUT( .HOLDSLIT(1),HOLD); 
ELSE 
DO; 
CALL STRINGSOUT( .HOLDSLIT(1),HOLISLIT(@)); 
CALL FILLSSTRING(HOLD - HOLDSLIT(@),” “)3 
END$ 
END; 
ELSE IF PENDINGSLITERAL = 1 THEN 
Ol 
DCL (HSDFC,HSLENGTH,H,L,LSDEC,LSLENGTH,SIGN,TYPE) 
BYTE, TEMP(20) BYTE, ZONE LIT ’8OR’3 
IF ((TYPE := GETSTYPE) < 16 OR (TYPE > 21 THEN 
CALL PRINTSERROR( “NV“’)3 
LSLENGTH = GETSLENGTH3 
LSDEC = LSLENGTH ~ GETSDECIMAL; 
IF TYPE = 26 THEN LSDEC = LSDEC @ 13 
HSLENGTH = HOLDSLIT(32);3 
HSDEC = HSLENGTEH + 1; 


SIGN = °+7%3 
IF HOLDSLIT(1) = “°-”% THEN 
SIGN = ’="5 


DO H = 1 TO HSLENGTH; 
IF HOLDSLIT(H) = “.° THEN HSDEC = 8; 
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DO L = @ TO 19; 
TEMP(L) = °0°3 
g 


END 

L = LSDEC —- 1; 

H = HSDEC; 

DO WHILE (((L := L +1) < LSLENGTH) AND 

((H s= 8 + 1) <= HSLENGTE)); 

TEMP(L) = HOLDSLIT(H); 

END; 

LoD, 

H = HSDEC; 

DO WHILE (((L :=L-1 255) AND 


i -< 
(Gene. — ' - 1) > @) AND 
(PROLDSEET(H) <> SIGN)); 
TEMP(L) = HOLDSLIT(H); 
END; 
IF ((H > 1) OR 
((H = 1) AND (HOLDSLIT(1) <> SIGN))) THEN 
CALL PRINTSERROR( “SL’);3 
IF SIGN = ’=" THEN 
IF TYPE = 17 THEN 
TEMP(@) = TEMP(@) OR ZONE; 
ELSE IF TYPE = 18 THEN 
TEMP(LSLENGTH) = TEMP(LSLENGTH) OR ZCNE;3 
We TYPE = 19 TEEN 
DO; 
IF TEMP(@) <> °@° THEN 
CALL PRINTSERROR( “SL’)3 
TEMP(2) = SIGN; 
END; 
ELSE IF TYPE = 2@ THEN 
TEMP(LSLENGTH -— 1) = SIGN; 
IF TYPE = 21 THEN 
DO; 
IF SIGN = °+° THEN 
TEMP(LSLENGTH) = °@’3 
ELSE TEMP(LSLENGTR) = “173 
IF (LSLENGTH MOD 2) THEN L = @}3 
ELSE 
DO; 
CALL BYTESOUT(TEMP(2) - 308); 
te aie 


END} 

DO WHILE L < LSLENGTH; 
CALL BYTESOUT(SHL((TEMP(L) - 30H) ,4) 

OR (TEMP(L + 1) - 32@EF));3 

L=L _+ 2; 

END} 

DOmle= LSLENGTH / 2 + 2 TO LSLENGTE; 
CALL BYTESOUT(2H): 
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END; 
END; 
ELSE CALL STRINGSOUT(.TEMP,LSLENGTH); 
END; 
IF NOT VALUESFLAG THEN PENDINGSLITERAL = @; 
END REDEFSORS VALUE; 


REDUCESSTACK: PROC; 
DCL HOLDSLENGTH ADDRESS; 
CALL SETSCURSSYM; 
CALL REDEFSORSVALUE;3 
HOLDSLENGTH = GETSSSLENGTH} 
IF GETSTYPE > OCCURSSTYPE AND GETSTPLSSIZE <> @ THEN 
DO; 
HOLDSLENGTH=HOLDSLENGTH * GETSTBLSSIZ53 
IF (DSCNT := DSCNT - 1) <> @ THEN 
OCCURSSPTR = GETSPREVSOCCURS; 
MESh OGCURSSEIR = OF 
END; 
IDSSTACKSPTR=IDSSTACKSPTR — 13 
CALL SETSCURSSYM; 
CALL SETSSSLENGTH(GETSSSLENGTE + HOLDSLENGTH) ; 
feel ORSTYPE (GROUP); 
END REDUCESSTACK} 


ENDSOFSRECORD: PROC} 
DO WHILE IDSSTACKSPTR <> @;3 
CALL SETSCURSSYM; 
CALL REDEFSORSVALUE; 
IDSSTACK(IDSSTACKSPTR) = @; 
IDSSTACKSPTR = IDSSTACKSPTR - 13 
END} 
CALL SETSCURSSYM; 
CALL REDEFSORSVALUSE} 
IDSSTACK(2) = @;3 
TEMPSHOLD = ALLOCATE(GETSSSLENGTS); 
END ENDSOFSRECORD; 


CONVERTSINTFGER: PROC} 
DCL INTEGER ADDRESS; 
INTEGER = @; 
DO I = 1 TO VARC(Q); 
IF NOT DIGIT(VARC(I)) THEN CALL PRINTSERROR( °NN’)3 
INTEGER = SHL(INTEGER,3) + SHL(INTEGER,1) + 
(VARC(I) -— °8’); 
END3 
VALUE(SP) = INTEGER} 
END CONVERTSINTEGER} 


ORSVALUE: PROC(PTR,ATTRIB); 
DCL PTR BYTE, ATTRIB ADDRESS; 
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VALUE(PTR) = VALUE(PTR) OR ATTRIB; 
END ORSVALUE; 


BUILDSFCB: PROC} 

DCL TEMP ADDRESS; 

DCL BUFFER(12) BYTE,(CHAR,I,J) BYTE; 

GAG Ler ILL( -BUFFER, ” -412)3 

IF VARC(2) = “:° THEN 

DO} 

BUFFER (2) 
2 


VARC(1) AND @OFH; 


BUFFER (@) 
eS as 
END; 

s = 1; 

DO WHILE (J < 12) AND (I< VARC( 
IF (CRAR := VARC(I := I +1 
ELSE DO; 

BUFFER(J) = CHAR; 
J= J + 1; 
END; 

END; 

CALL SETSADDR2(TEMP := ALLOCATE(165)); 

CALL STARTSINITIALIZE( TEMP ,37)3 

CALL STRINGSCUT( .BUFFER,12)3 

CALL FILLSSTRING(25,0); 

CALL ORSVALUE(SP - 1,1); 

END BUILDSFCB; 


i 
& 
= ~@ 


) 


2)); 
i, eee =o), 


SETSSIGN: PROC(NUMB)3 
DCL NUMB BYTE} 
IF GETSTYPE = 17 THEN CALL SETSTYPE(VALUE(SP) + NUMB);3 
ELSE CALL PRINTSEFRROR(’°SG’); 
IF VALUE(SP) <> @ THEN 
CALL SETSSSLENGTA(GETSSSLENGTE + 1); 
END SETSSIGN; 


NUMSTRUNC: PROC; 
DCL (1,J,TRUNCSTYPE,TRUNCSZERC ,SIGNSFLAG,DECSFLAG) EYTE; 
TRUNCSZERO = TRUE} 

SIGNSFLAG ,DECSFLAG = FALSE; 
BePboLIT(d),1I = @3 

oo 1; 

IF ((TRUNCSTYPE := GETSTYPE) >= 16) 


AND (TRUNCSTYPE <= 21) THEN 
DO WHILE J <= VARC(@);3 


IF (VARC(J) <> °+°%) AND (VARC(J) <> °-’) THEN 
DO$ 
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IF (VARC(J) = °O°) AND TRUNCSZERO THEN J = J; 
ELSE IF ((VARC(J) >= °O’) AND (VARC(J) <= °97)) 
OR (VARC(J) = °.°) THEN 
DO; 
IF DECSFLAG AND (VARC(J) = °.%) THEN 
CALL PRINTSERROR( “MD );3 
ELSE DO; 
EOLDSLIT(HOLDSLIT(2) := ROLDSLIT(@) +1) = 
VERC(J); 


IF VARC(J) <> °@° THEN TRUNCSZFRO = FALSE; 
Pace = 10, LPAPN DNCSMEAG = TRUE? 
l;oer + 4; 
END; 
END; 
ELSE IF ((VARC(J) < °@’) OR (VARC(J) > ’9%)) 
(VARC(J) <> °.”%) THEN CALL PRINTSERROR( °NN’ 
END3 
ELSE IF SIGNSFLAG THEN CALL PRINTSERROR(’°MS’); 
ELSE IF (VARC(J) = °+°) OR (VARC(J} = °-*%) THEN 


AND 
yee 


y 


DO; 
IF TRUNCSTYPE = 16 THEN 
CALL PRINTSERROR( “SG” ); 
ELSE 
DO; 
FOLDSLIT(HOLDSLIT(3) := 
HOLDSLIT(@) + 1)=VARC(J)3 
SIGNSFLAG = TRUE; 
Y=] +1; 
END; 
END; 
J=J+1; 


END;/* DO WHILE LOOP */ 
PemPSLIT(@) = 1; 
IF ((HOLDSLIT(@) = 1) AND ((HOLDSLIT(1) = “+%) OR 
MOLDSLIT({1) = —")))} OR (HOLDSLIT(@) = °@°) THEN 
MOLDSLIT(@),ROLDSLIT(1) = @; 
END NUMSTRUNC3 


PICSANALIZER: PROC; 

DCL /* WORK ARFAS AND VARIABLES */ 
BUFFER(133) BYTE, 
CHAR BYTE, 
COUNT ADDRESS, 
DECSCOUNT BYTE, 
DECSFLAG BYTE, 
DIGITS BYTE, 
FLAG BYTE 
FLAGS (3) 1) 
FLOATSPSIT BYTE, 
FLOATSVALUE BYTE, 

I Byrn. 
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J ADDRESS, 


K BYTE, 

REPITITIONS ADDRESS, 

SAVE EYL 

TEMP ADDRESS, 

TYPE sp aae 

Ue x MASKS x OS * / 

ALPHA La eae 

ASEDIT ole a. 

ASN ier oA 

EDIT er te he. 

NUM LiL 16 

MOMSEDIT LIT “22°, 

DEC fier 6~C ee 

SIGNED LI tiene @, 

ASESMASK elon Shee eet): ner 
ASNSMASK Lee 711101010R’, 
ASNSESMASK it 71110@CCOR’, 
ALPHASMASK iy mri 12108 
NUMSMASK rir SOL Cais. 
NUMSEDSMASK fe lee 710Q022121B’, 
SSNUMSMASK inet “eren lene ieee 
/® TYPES */ 


MeTYPE LIT °72" 
ANTYPE LIT oe 
AMETYPE LIT °?7S", 
feeyPs LIT °16%, 
NETYPE LIT °’8O’, 
weeYPE LIT 173 


ATYPE en “8°, 


maGSCOUNT: PROC(SWITCH); 
DCL SWITCE RYTRE; 
FLAG = FLAG OR SWITCEZ; 
Pa cOUND T=—GOUNT + 1) < 1335 THEN 
BUFFER(COUNT) = CHAR; 
END INCSCOUNT; 


CHECK: PROC (MASK) BYTE; 

DCL MASK BYTE; 

RETURN NOT ((FLAG AND MASK) <> @);3 
END CHECK; 


PICSALLOCATE: PROC(AMT) ADDRESS; 
DCL AMT ADDRESS; 
IF (MAXSINTSMEM := MAXSINTSMEM - AMT) 
< NEXTSAVAILAELE THEN CALL FATALSERROR (°MO’); 
RETURN MAXSINTSMEM; 
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END PICSALLOCATES 


SIGN: PROC(CHAR) BYTE; 

CTCL CHAR EYTE; 

RETURN (CHAR = “+°) OR (CHAR = “-"); 
END SIGN; 


FLOATSCHECK: PROC(I)3 
Pec ITE 
IF FLOATSVALUR = @ AND FLAGS(I) THEN 
FLOATSVALUE = CHAR} 
IF CHAR <> FLOATSVALUR AND FLAGS(I) THEN 
CALL PRINTSERROR(’P1°); 
IF FLAGS (I) TEEN 
DO; 
FLOATSPSIT = COUNT + 13 
rT Cuice—mpiGl LS te); 
END; 
ELSE 
EReCG (ft) = TRUE; 
CALL INCSCOUNT(NUMSEDIT); 
END FLOATSCHECK;3 


/* PROCEDURE EXECUTION STARTS EERE */ 


CURSSYM = HOLDSSYM; 
IF (GETSLEVEL = VALUESLEVEL) THEN VALUESFLAG 
DECSFLAG, FLAGS (@),FLAGS(1) = FALSE; 
FLAGS(2) = TRUE; 
MOUNT .DECSCOUNT, DIGITS, FLAG, FLOATSVALUE,TYPE = @; 
/* CHECK FOR EXCESSIVE LENGTH */ 
IF VARC(2) > 30 THEN 
DO; 


FALSE; 


CALL PRINTSERROR( °PC’); 
RETURN} 
END; 
/* SET FLAG BITS AND COUNT LENGTH */ 
m= 13 
DO WHILE I <= VARC(2); 
IF (CHAR := VARC(I)) = °A’ THEN 
CALL INCSCOUNT( ALPHA); 
ELSE IF CHAR = “B’ TREN CALL INCSCOUNT(ASEDIT); 
ELSE IF CHAR 9° THEN 
DO; 


Pel use= DIGITS .— 15 
CALL INCSCOUNT(NUM)3 
END; 
ELSE IF CHAR 
ELSE IF (CHAR 
FLAG = 
ELSE IF (CEAR 


Seen CARL INCSCOUNT( ASN ) ; 
°S°) AND (COUNT=@) THEN 

LAG OR SIGNED; 
“V") AND (DECSCOUNT=0) THEN 


Weg 


289 





DO; 
FLAG = FLAG OR DEC; 
DECSCOUNT = COUNT; 
PECSHEAG =-TRUR; 
END} 
ELSE IF(CHAR = “/°) OR (CHAR=°@°) TEEN 
CALL INCS$COUNT(EDIT); 
Eom Peet AR = s THEN CALL FLOATSCHTCK (2); 
ELSE IF SIGN(CHAR) TEEN CALL eae Pei) 
ELSE IF (CHAR = °*”) OR (CHAR = TREN 
CALL FLOATSCHECK(2)3 
ELSE IF CHAR = °,° THEN CALL INCSCOUNT(NUMSEDIT); 
ELSE IF (CHAR = ”.°) AND (DECSCOUNT=@) TEEN 
DO} 
CALL INCSCOUNT(NUMSEDIT); 
DECSCOUNT = COUNT; 
PeCcwIAG = “ERUR: 
END; 
ELSE IF ((CEAR = °C’ AND VARC(I +1 
(CHAR = “°D’ AND VARC(I + 1)=’B 
I = VARC(@) — 1 AND NOT FLAGS (1 
DO; 
GAL INCSCOUNT(NUMSEDIT); 
CUAR = VARC(I:=I + 1)3 
CALL INCSCOUNT(NUMSEDIT); 
IF NOT DECSFLAG THEN 
DO; 
DECSCOUNT = VARC(Z) — 13 . 
DECSFLAG = TRUE; 
END; 
END} 
ELSE IF (CHAR = °(°) AND (COUNT<>@) TEEN 
DO; 
SAV ie= VARG(E — 1); 
REPITITIONS = @; 
DO WHILE (CHAR := VARC(I := I + 1)) <> %)7’3 
IF CHAR < °@” OR CHAR > °9” THEN 
CALL PRINTSERROR( °P2°); 
REPITITIONS = SHL(REPITITIONS,3) + 
SHOP LUET PONG, 1) 2eGGHAR = “wv ); 
END; 
CHAR = SAVE; 
IF REPITITIONS <> @ THEN 
DO; 
DO J = 170 REPITITIONS - 1; 
CAEGENGSCOUNT (2); 
END; 
IF SIGN(SAVE) OR SAVE = “$ 


? 


OR SAVE = °2° OR SAVE = ’9° 
OR SAVE = °*”% THEN 
PieuLSu=—eDPGITS + REPITITIONS -— 1; 
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END; 
ELSE 
COUNT = COUNT —- 1; 


END; 
Pilot 00; 
CALL PRINTSERROR(’°P3” ); 
RETURN} 
END; 
l=) lee i; 


END; /* END OF TO WHILE I <= VARC */ 
IF NOT DECSFLAG AND SIGN(VARC({I - 1)) THEN 


DO; 
DECSCOUNT = VARC(G); 
DECSFLAG = TRUE} 
END; 
/* AT THIS POINT THE TYPE CAN BE DETERMINED */ 
IF CHFCK(NUMSMASK ) TERN TYPE = NTYPE; 
ELSE IF CEECK(SNUMSMASK) THEN TYPE = SNTYPE; 
ELSE IF CHECK(ALPHASMASK) THEN TYPE = ATYPRE; 
ELSE IF CHECK(ASESMASK) TEEN TYPE = <METYPE;} 
ELSE IF CHECK(ASNSMASK) THEN TYPE = ANTYPE; 


ELSE IF CHECK(ASNSESMASK) AND (( (FLAG AND @68) <> @) 
OR ((FLAG AND O98) <> @) OR (( FLAG AND 12H) <> @)) 
THEN TYPE = ANETYPE; 
ELSE IF CHECK(NUMSEDSMASK) THEN 


DO; 
TYPE = NETYPRE; 
IF FLOATSVALUE <> @ THEN 
DO; 
I = 13 
[TO WEILE VARC(I) <> FLOATSVALUE; 
le or + 1; 
END; 
romiee= (ess 1 TO FLOATSPSIT; 
IF VARC(I) <> FLOATSVALUE AND 
VARC(I) <> °B’ AND 
VARC(I) <> °/” AND 
VARC(I) <> °° AND 
ARG Ci) <>. THEN 
DO; 
CALL PRINTSERROR( “P4"); 
lo =F ROA TS PSI I 
END; 
END; 
END; 
END; 
IF TYPE = @ THEN CALL PRINTSERROR( °PS’); 
ELSE DO; 


IF (GETSTYPE = 128) TEEN 
CAEL SEISTYPE(i2s + TYPE); 
ELSE CALL SETSTYPE(TYPE); 
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CALL SETSSLENGTH(COUNT + GETSSSLENGTH)$ 
IF (TYPE AND 64) <> @ THEN 


DO; 
CALL SETSADDR2(TEMP := 
PreomnLOCAT S| COUNT )); 
CALL STARTSINITIALIZE(TEMP, COUNT) ; 
CALL STRINGSOUT( .BUFFER + 1,COUNT); 
END; 


IF DIGITS > 18 THEN 
CALL PRINTSERROR( °P6"); 
IF DECSFLAG THEN 
CALL SETSDECIMAL(COUNT - DECSCOUNT) ; 
END} 
IF (NOT TRUNCSFLAG) AND ((TYPFE = 16) OR (TYPE = 17)) THEN 
DO; 
DO K = @ TO HOLDSLIT(@); 
VARC(K) = HOLDSLIT(K); 
END; 
CALL NUMSTRUNC; 
TRUNCSFLAG = TRUE; 
END; 
END PICSANALIZER; 


SETSFILESATTRIB: PROC} 
DCL TEMP ADDRESS, TYPE BYTE; 
IF CURSSYM <> VALUE(MPP1) THEN 
Dos 
TEMP = CURSSYM; 
CURSSYM = VALUE(MPP1);3 
SYMBOLSADDR(RELSID) = TEMP; 
END; 
IF NOT (TEMP := VALUE(SP - 1)) THEN 
CALL PRINTSERROR( ‘NF“); 
ELSE DO; 
IF (TEMP = 1) OR (TEMP=5) THEN TYPE=SFOUENTIAL} 
ErSoneleereMP = 15 THEN TYPE=RAN DOM; 
eon tee = 13 TREN TYPE=SEQSSREATIVE; 
ELSE DO; 
CALL PRINTSERROR(’IA’);3 
PYPE = 1; 
END; 
END} 
CALL SETSTYPE(TYPE + URSMASX); 
END SETSFILESATTRIB;} 


LOADSLITERAL: PROC(LITSONE); 
DCL (I,LITSONE,LITSTYPE) BYTE; 
LITSTYPE = GETSTYPE; 
IF LITSTYPE <> @ THEN VALUFSFLAG = FALSB; 
ELSE DO; 
VALUESFLAG = TRUE; 
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VALUESLEVEL = GETSLEVEL; 
END} 
IF PENDINGSLITERAL <> @ THEN CALL PRINTSERROR (’LE’); 
ELSE IF (LITSONE = @) OR (LITSTYPE = @) THEN 
DO; 
DO I = @ TO VARC(O): 
HOLDSLIT(I) = VARC(I); 
END; 
IF (LITSONE = 1) AND (LITSTYPE = @) THEN 
TRUNCSFLAG = FALSE} 
END} 
ELSE IF (LITSONE = : AND ((LITSTYPE >= 16) AND 
(LITSTYPE <= 21)) THEN 
CALL NUMSTRUNC; 
ELSE IF (LITSONE = 1) AND (LITSTYPE <> @) THEN 
DO; 
CALL PRINTSERROR( ‘LV’ ); 
DO f = @ TO WARC(G); 
ROEDoGIE (Tl ie= VARC (I); 
END} 
PEN INGSCLIEORAL = 2; 
END; 
END LOADSLITERAL; 


REDFFSTEST: PROC; 
DCL SAVESREDEF BYTE, 
(SAVESREDEFSONE,SAVESRFDEFSTWO) ADDRESS} 
SAVESREDEFSONE = REDEFSONE; 
SAVESREDEFSTWO = REDEFSTWO; 
REDEFSONE = CURSSYM; 
CALL SETSCURSSYM; 
IF (GETISTYPE > OCCURSSTYPE) AND (GETSTBLSSIZE <> @) THEN 
IF (DSCNT := DSCNT - 1) <> @ THEN 
OCCURSSPTR = GETSPREVSOCCURS; 
BESE OCCURSSPTR = Q; 
REDFEFSTWO = CURSSYM; 
SAVESREDEF = REDEF; 
Raper = TRUE; 
CALL REDEFSORSVALUE; 
MOSSTACK(IDSSTACKSPTR) = @3 
IDSSTACKSPTR = IDSSTACKSPTR -— 13 
REDEFSONE = SAVESREDEFSONE; 
REDEFSTWO = SAVESREDEFSTWO;3 
REDFF = SAVESREDEF; 
END REDEFSTEST; 


CHECKSLVLSFILES: PROC; 
DCL NEWSLEVEL BYTE; 
HOLDSSYM,CURSSYM = VALUE(MP - 1)3 
CALL SETSLEVEL(NEWSLEVEL s= VALUE(MP - 2));3 
IF NEWSLEVEL = 1 THEN 
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DO; 
IF IDSSTACK(®) <> @ THEN 
DO} 
DO WHILE STACKSLEVEL D 1; 
CALL REDUCESSTACK; 
END; 
DO WHILE IDSSTACKSPTR <> @;3 
CALL SETSCURSSYM; 
CALL REDEFSORSVALUE; 
IDSSTACK(IDSSTACKSPTR) = 23 
IDSSTACKSPTR = IDSSTACKSPTR - 13 
END; 
CURSSYM = HOLDSSYM;3 
CALL SETSREDEF(IDSSTACK(@),VALURP(MP - 1));3 
VALUE(MP) = 13 /* SET REDEFINE FLAG ¥*/ 
END; 
END; 
ELSE DO WHILE STACKSLEVEL >= NEWSLEVEL; 
CALL REDUCESSTACK; 
END; 


END CHECKSLVLSFILES; 


CHECKSLVLSWORK: PROC; 


DCL NEWSLEVEL BYTE, 
SAVESSYMSLVL Bele, 
STACKSREDUCED BYTE, 


SAVESREDEF Bun, 
REDEFSFLAG Pete, /=NX. LVL IS A REDEFINES*/ 
SAVESSYM ADDRESS; 


SETSVALUESCLAUSE: PROC; 


END 


SAVESREDEF = RELEF; 
REDEF = FALSE; 

CALL SETSCURSS YM; 
CALL REDEFSORSVALUE} 
REDEF = SAVESREDFF; 
CURSSYM = HOLDSSYM; 
SETSVALUESC LAUSE; 


TRUNCSFLAG = TRUE} 

STACKSREDUCED = FALSE; 

HOLDSSYM,CURSSYM = VALUE(MP —- 1); 

CALL SETSLEVEL(NEWSLEVEL := VALUR(MP - 2));3 
REDEFSFLAG = VALUE(MP); /*SET IN PROD #64*/ 
eee” LEVEL = 1 OR NEWSLEVEL = 77 THEN 


9 
IF STACKSLEVEL = 77 THEN 
CALL ENDSOFSRECORD; 
ELSE 
DO; 
DO WHILE STACKSLEVEL > i 
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AND IDSSTACK(IDSSTACKSPTR) © @; 
SAVESSYM,CURSSYM = IDSSTACK(IDSSTACKSPTR - 1); 
SAVESSYMSLVL = GETSLEVFL; 

IF SAVESSYMSLVL = STACKSLEVEL THEN 

DO; 

CURSSYM = SAVESSYM; 

CALL REDEFSTEST; 

END} 

ELS EEe STACKSLEVEL > 1 THEN 
Do; 
CALL REDUCESSTACK; 
IF VALUESFLAG 
AND (VALUESLEVEL = STACKSLEVEL) THEN 
DO; 
VALUESFLAG = FALSE; 
CALL SETSVALUESCLAUSE; 
END; 
END; 
END;/* DO WHILE LOOP */ 
IF STACKSLEVEL = 1 AND IDSSTACKSPTR <> @ THEN 
DO; 
CURSSYM = IDSSTACK(IDSSTACKSPTR - 1); 
CALL REDEFSTEST; 
END; 
IF REDEFSFLAG = @ 
AND IDSSTACK(IDSSTACKSPTR) <> @ THEN 
DO; 
CALL ENDSOFSRECORD; 
REDEF = FALSE} 
END; 
IF (REDEFSFLAG = 1) 
AND (IDSSTACK(IDSSTACKSPTR ) 
THEN CALL SETSVALUESCLAUSS 
END; 


END ; 
ELSE IF STACKLEVEL = 77 THEN CALL PRINTSERROR( “L?7’);3 
ELSE IF STACKSLFEVEL >= NEWSLEVEL TEEN 
DO; 
IF (STACKSLEVEL = NEWSLEVEL) AND (REDEFSFLAG = 1) AND 
(IDSSTACK(IDSSTACKSPTR) = REDEFSONE) THEN 
CALL SETSVALUFSCLAUSE; 
DO WHILE NOT STACKSREDUCET; 
SAVESSYM,CURSSYM = IDSSTACK(IDSSTACKSPTR - 1)3 
SAVESSYMSLVL = GETSLEVEL; 
IF SAVESSYMSLVL = STACKSLEVEL TEEN 
DO; 
CURSSYM = SAVESSYM;3 
CALL REDEFSTEST; 
END; 
ELSE IF (STACKSLEVEL >= NEWSLEVEL) 
AND (REDEFSFLAG = @) TEEN 


= REDFFSONE) 
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DO; 
CALL REDUCESSTACK; 
IF VALUESFLAG AND (VALUFSLEVEL = STACKSLEVEL) 
AND (VALUESLEVEL = NEWSLEVEL) THEN 
DO; 
VALUESFLAG = FALSE; 
CALL SETSVALUESCLAUSE; 
END} 
IF STACKSLEVEL<NEWSLEVEL THEN 
STACKSREDUCED = TRUE} 
END; 
ELSE IF (STACKSLEVEL >= NEWSLEVEL) 
AND (REDEFSFLAG = 1) THEN 
DO; 
IF STACKSLEVELDNEWSLEVEL THEN 
CALL REDUCESSTACK; 
IF VALUESFLAG 
AND (VALUESLEVEL = STACKSLEVEL) TEEN 
DO; 
VALUESFLAG = FALSE; 
CALL SETSVALUESCLAUSE; 
END} 
IF STACKSLEVEL <= NEWSLEVEL THEN 
STACKSREDUCED = TRUE; 
END} 
END; /* DO WHILE LOOP */ 
END} 
CURSSYM = HOLDSSY™M; 
END CEECKSLVLSWORKX; 


CODESGEN: PROC( PRODUCTION); 
DCL PRODUCTION BYTz, 
Peis y rs BYTE; 
IF PRINTSPROD THEN 


DO; 

CALL CRLF; 

CALL PRINTCHAR( POUND) ; 

CALL PRINTSNUMBER( PRODUCTION ); 
END; 


DO CASE PRODUCTION; 
meee RODUCTION §S *¥/ 


/* CASE @ NOT USED 7, 
3 
a i CeO cthN mee Cle DIV> <E=eDEVOeCD = DIV> */ 
Ue i: PROCEDURE a // 
DO; 


COMPILING = FALSE; 
CALL DISPLAYSLINE; 


Za 





& 
wa @ 


/* 
/* 


2 <ID — DIVYD :3:= IDENTIFICATION DIVISION 
PROGRAM-ITI . 
2 <COMMEN Le aero D—inis T> 
; /* NO ACTION REQUIRED */ 
o <ID-LISTD ::= <AUTHD <INSD <DATED <SECD> 
/* NO ACTION REQUIRED */ 
ye <AUTH> ::= AUTHOR . XCOMMENTD . 
’ * NO ACTION REQUIRED */ 
5 \!l <EMPTY> 
; /*®* NO ACTION REQUIRED */ 
6 <INSD s:= INSTALLATION . <COMMENTD . 
; /* NO ACTION REQUIRED */ 
7 \! <EMPTY> 
; /* NO ACTION REQUIRED */ 
8 CDATED ¢3:= DAT® - WRITTEN .« <COMMENTD 
; /* NO ACTION REQUIRED */ 
9 NISCUMETY > 
; /* NO ACTION RECUIRED */ 
19 <SEC> 3::= SECURITY . <COMMENTD . 
; /* NO ACTION REQUIRED */ 
11 \! <EMPTY> 
} /* NO ACTION REQUIRED */ 
12 <COMMENTD s3:= <CINPUTD 
; /* NO ACTION REQUIRED */ 
ILS) \! <COMMENTD <INPUTD 
’ /* NO ACTION REQUIRED */ 
14 <E ~- DIVD ::= ENVIRONMENT DIVISION 
CONFIGURATION SECTION 
14 Cue Oon > G1 = O> 
; /* NO ACTION REQUIRED */ 
15 \! <EMPTY> 
/* NO ACTION REQUIRED */ 
16 <SRC — OBJD 3:3:= SCURCE -— COMPUTER . <COMMENTD 
<DEBUG> . 
16 OBJECT - COMPUTER . <COMMENTD 
; /* NO ACTION REQUIRED */ 
Lee <DEBUG> ::= DERUGGING MODE 
DEBUGGING = TRUE; /* SETS A SCANNER TCGCLE */ 
18 NPS EMPTY > 
a /* NO ACTION REQUIRED */ 
19 <I-0> ::= INPUT-OUTPUT SECTION . FILE-CONTROL 
19 . <FILE - CONTROL - LISTD <IC> 
’ /* NO ACTION REQUIRED */ 
20 \! <EMPTY> 
; * NO ACTION REQUIRED */ 
ol <FILE-CONTROL-LISTD ::= <FILE-CONTROL-ENTPRY > 
’ /* NO ACTION REQUIRED */ 
Le \! <FILE-CONTROL-LIST> 
Le <FILE-CONTROL-ENTRY > 
’ /* NO ACTION RECUIRED */ 


at 


x / 


ay 
x 


ye 


es 


a 
*/ 


ta 
a 


soles 
~~ 


a 


a 
4 / 






/* 23 <FILE-CONTROL-ENTRYD ::= SELECT <ID> 7 


/* CTT RT SUTh—LIST> . * / 
CALL SETSFILESATTRIBP; 

/* 24 <ATTRIBUTE-LIST> 2::= <ONE-ATTRIB> x / 
; /* NO ACTION REQUIRED */ 

* 25 \! <ATTRIBUTES-LIST> * / 

> <ONF-ATTRIB>  / 
VALUR(MP) = VALUE(SP) OR VALUE(MP); 

/* 26 <ONE-ATTRIBD ::= ORGANIZATION <ORG-TYPED * / 
VALUE(MP) = VALUE(SP); 

/* ou \! ACCESS <ACC-TYPE>D <REFLATIVED */ 
VALUE(MP) = VALUE(MPF1) OR VALUE(SP); 

/* 22 Nit-AcsiGNy <INPUT> a7, 
feo BUILDS FCB} 

[% 29 <ORG-TYPED :3:= SEQUENTIAL a / 
; /* NO ACTION REQUIRED - DEFAULT */ 

/* 30 \! RELATIVE y/ 
CALL ORSVALUE(SP,4);3 

/* eu \! INDEXED aif 
CALL PRINTSERROR( ‘NI’ );5 

/* 22 <ACC-TYPED ::= SEQUENTIAL * / 
; /* NO ACTION REQUIRED - DFFAULT */ 

/* oS \! RANDOM * / 
CALL ORSVALUE(SP,2);3 

iq 34 CRELATIVED ::= RELATIVE <ID>D aay, 
DO; 


CALL ORSVALUE(MP,8)}3 
CURSYM = VALUER(SP); 
CALL SETSTYPE(RELSKEYSUR) ; 


END; 

ye Ss \l <EMPTY> ay 
: /* NO ACTION REQUIRED - DEFAULT *¥/ 

yx 36 <IC> 2::= I-O-CONTROL . <SAME-LIST>D x / 
; /* NO ACTION REQUIRED */ 

/* 37 \! <EMPTY> x / 
; /* NQ ACTION REQUIRED */ 

ye Z8 <SAME - LISTD ::= <SAME - ELEMENT) =f 
; /* NO ACTION REQUIRED */ 

oe 39 \! <SAME - LIST> <SAME - ELEMENT D*/ 
; /* NC ACTION REQUIRED */ 

Vs 42 <SAME-ELEMENTD ::= SAME <XID-STRING> . i 
; /* NO ACTION REQUIRED */ 

ye 41 <ID-STRING> ::= <ID>d %* / 
; /* NO ACTION REQUIRED */ 

ie 42 \! <ID-STRING> <ID> x / 
; /* NO ACTION PECUIRED */ 

/* 43 <D-DIV> ::= DATA DIVISION . <FILE-SFCTIOND e7/ 

[* <WORK> * / 

ys 43 <LINKD 7 
; /* NO ACTION REQUIRED */ 

/* 44 <FILE-SECTIOND s:= FILE SECTICN . <FILE-LIST> */ 


Zo 





/% 


/* 
/* 
he 
[% 
/* 
/* 


/* 
/* 


/* 
/* 


FILESSECSEND = TRUE; 
45 SMP Y> 
FILESSECSEND = TRUE; 
46 Siero > ss= <FILES> 
; /* NO ACTION REQUIRED */ 
47 Niecurnn bisa > <FILES> 
: /* NO ACTION REQUIRED */ 
45 <FILES> ::= FD <ID> <FILE-CONTROLD . 
48 <RECORD-DESCRIPTION> 
DO; 


DO WEILE STACKSLEVEL > 13 
CALL REDUCESSTACK; 
END} 
CALL ENDSOFSRECORD; 
Repke = PALSES 
END; 
49 <FILE-CONTROL> ::= <FILE-LIST> 
CALL SETS IOSADDRS; 
EQ \! <EMPTY>D 
CALL SETSIOSADDRS} 


5 <FILE-LIST> s:= <FILE-ELEMENTD 
; J~= NO ACTION REQUIRED */ 
a Nh CP Pie =2isi> <FILE=—ELEMENI > 
: /* NO ACTION REQUIRED */ 
BS <PILE-ELEMENT>D ::= BLOCK <INTEGFR> RECORDS 
} /* NO ACTION REQUIRED - FILES NEVER ELOCKED */ 
54 \! RECORD <REC-COUNT>D 
CALL SETSSLENGTH( VALUE(SP) )3 
55 \! LAREL RECORDS STANDARD 
; /*® NO ACTION REQUIRED*/ 
56 NIEABEL RECORDS OMITTED 
9 /* NO ACTION REQUIRED*/ 
ae \! VALUE OF <ID - STRING 
; /* NO ACTION REQUIRED */ 
S13 <REC-COUNTD ::= <INTEGERD 
' /* NO ACTION REQUIRED — VALUE(SP) CORRECT ay 
ene, \! <INTEGERD TO <INTEGERD 
DQ; 


VALUE(MP) = VALUE(SP); /* VARIABLE LENGTE */ 
CALL SETSTYPE(VARIABLESLENG)3 /* SET TO VARIABLE */ 
END; 


Eg CWORKD :3= WORKING-STORAGE SECTION . 
68 <RECORD-DESCRIPTION> 
C0; 
IF STACKSLEVEL<>77 THEN 
DQ; 


DO WHILE STACKSLEVEL > 1; 
CURSSYM = IDSSTACK(IDSSTACKSPTR - 1); 
IF GETSLEVEL = STACKSLEVEL THEN 
CALL REDEFSTEST; 
ELSE IF STACKSLEVEL > 1 THEN 
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x / 
*/ 
*/ 


#/ 
xe / 


7, 


ay) 
ay 





/* 


a 
y 


j/® 
/* 


/* 
/* 


/* 
/* 


/* 


/* 


/* 


CALL REDUCESSTACK; 
END; 
IF STACKSLEVEL = 1 AND IDSSTACKSPTR <> @ THEN 
DO; 


CURSSYM = IDSSTACK(IDSSTACKSPTR - 1); 
IF REDEF THEN CALL REDEFSTEST; 


END; 
END; 
CALL ENDSOFSRECORD; 
END; 
El \! <EMPTY>D 77, 
; /* NO ACTION REQUIRED */ 
62 <LINK> ::= LINKAGE SECTION . 7, 
62 <RECORD-DFSCRIPTION> a7 
; /* NO ACTION REQUIRED */ 
63 \! <EMPTY> a7, 
; /* NO ACTION REQUIRED */ 
64 CRECORD-DESCRIPTIOND ::= <LEVEL-ENTRYD x / 
; /* NO ACTION REQUIRED */ 
65 \! <RECORD-DESCRIPTION>D */ 
65 <LEVEL-ENTRY> * / 
; /* NO ACTION REQUIRED*/ 
E6 <LEVEL-ENTRYD ::= <INTEGER> <DATA-ID> / 
66 <REDEFINES> <DATA-TYPED .  / 
DO} 
CALL LOADSLEV®2L; 
IF (PENDINGSLITERAL <> @) AND (NOT VALUESFLAG) THEN 
PENDINGSLITSID = IDSSTACKSPTR; 
END} 
67 <DATA-ID> ::= <ID> * / 
IF NOT UISFLAG THEN 
DO; 
IF GETSTYPE = RELSKEYSUR TEEN 
CALL SETSTYPE(RELSKEY)} 
ELSE 
CALL PRINTSERROR( DD’); 
END; 
68 \! FILLER x / 
DO} 
CURSSYM, VALUE(SP) = NEXTSSYM; 
CALL BUILDSSYMBOL(Q); 
END} 
69 <REDEFINES> ::= REDEFINES <ID> a7 
DO; 


IF UISFLAG THEN 

CALL PRINTSERROR( “UD’); 
CALL SETSREDEF(VALUE(SP) ,VALUE(SP - 2))3 
VALUE(MP) = 13 /* SET REDEFINE FLAG ON */ 
IF NOT FILESS®CSEND THEN 

CALL PRINTSERROR(°R3’); 
CALL CHECKSLVLSWORK; 
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/* 


/* 
/* 
/* 
/* 
/* 
/* 
/* 
/* 
/* 
/* 
/* 


/* 
/* 


/* 


/* 
ye 


/* 


END; 
20 Naeem TY > 
DO; 
IF NOT FILESSECSEND THEN 
CALL CHECKSLVLSFILES; 
ELSE CALL CHECKSLVLSWORK ; 
END} 
71 <DATA-TYPE> ::= <PROP-LIST> 
; /* NO ACTION REQUIRED */ 
72 \! <EMPTY> 
: /* NO ACTION REQUIRED */ 
aS <PROP-LIST> ::= <DATA-ELEMENTD 
; /* NO ACTION REQUIRED */ 
74, \l <PROP-LIST> <DATA-FLEMENT>D 
; /* NO ACTION REQUIRED */ 
75 <DATA-ELEMENT> ::= PIC <INPUTD 
CALL PICSANALIZER; 


76 \! USAGE COMP 
; /* NO ACTION REQUIRED-NOT IMPLEMENTED */ 
77 NIDUSAGE COMP-3 


CALL SETSTYPE(COMP); 
a \! USAGE COMPUTATIONAL 
3 /* NO ACTION REQUIRED-NOTIMPLEMENTED */ 


qo \! USAGE DISPLAY 
; /* NO ACTION REQUIRED - DEFAULT */ 
8g \! SIGN LEADING <SEPARATED 


Oa SETSSIGN(17);3 
81 \! SIGN TRAILING <SEPARATE> 
CAEL SETSSIGM(18); 


&2 \! OCCURS <INTEGER> IND FXED 
Re <ID> 
; /* NO ACTION ACTION REQUIRED-NOT IMPLEMENTED */ 
r 83 \! OCCURS <INTEGER> 
9 
CALL SETSTBLSSIZE(VALUE(SP) ); 
DSCNT = DSCNT + 13 
CALL PROCESSSOCCURS; 
CCGRSSeTR = CURSSYM; 
IF (TEMPSTWO := GETSLEVEL)=1 OR TEMPSTWO=77 THEN 
CALL PRINTSERROR( °OL’)3 
END; 
Q4 \! SYNC <DIRECTION>D 


} /* NO ACTION REQUIRED - BYTE MACHINE */ 
85 \! VALUE <LITERAL> 
IF NOT FILESSECSEND THEN 
DO; 


3 
CALL PRINTSERROR( “VE")$5 
PENDINGSLITERAL = 23 
END} 
86 <DIRECTIOND ::= LEFT 
; /* NO ACTION REQUIRED */ 


ee 


st 


7, 


* 


A 


*/ 





/* 
/* 
i 


a 


/* 


/* 
/* 
/* 
/* 
/* 


87 NiePRnCH. * / 
: /* NO ACTION REQUIRED *¥/ 
ER \! <EMPTY> a / 
; /* NO ACTION REQUIRED */ 
89  <SEPARATE> ::= SEPARATE a/, 
VALUE(SP) = 23 
90 \! <EMPTY> * / 
; /* NO ACTION REQUIRED */ 
1 <LITERAL> ::= <INPUTD aR 
Ol; 
Ir ((LITSTYPE := GETSTYPE) < 16) OR 
(LITSTYPF > 21) THEN 
DO; 
CALL PRINTSERROR( “NV’)3 
CALL LOADSLITERAL(@)5 
PENDINGSLITERAL = 23 
END} 
FLSE DO; 
CALL LOADSLITERAL(1); 
PENDINGSLITERAL = 13 
END; 
END; 
92 Nile Char > oy, 
DO; 
CALL LOADSLITERAL(@);3 
PENDINGSLITERAL = 23 
END; 
93 \l ZERO % / 
PENDINGSLITERAL = 33 
94 \! SPACE aay, 
PENDINGSLITERAL = 4; 
95 \! QUOTE ey, 
PENDINGSLITERAL = 53 
96 <INTEGERD ::= <INPUTD % / 
CALL CONVERTSINTEGER; 
97 <ID> 2::= <INPUTD ay. 
DO 
VALUE(SP) = MATCH; /* STORE SYMBOL TABLE POINTERS */ 
IF FILESDESCSFLAG TREN 
Dol; 
FILESDESCSFLAG = FALSE; 
IF UISFLAG THEN 
CALL PRINTSERROR( “UD’);3 
ELSE 
IF GETSTYPEDURSMASK THEN 
CALL SETSTYPE(GETSTYPE — URSMASK); 
ELSE 
CALL PRINTSERROR( “DD” );3 
END; 
END; 
END; /* END OF CASE STATEMENT */ 


Zee 






END CODESGEN; 


GETINi: PROC BYTE; 
RETURN INDEX1(STATE); 
END GETIN1; 


Per IN2: PROC BYTE; 
RETURN INDEX2(STATE); 
END GETING; 


INCSP: PROC; 
IF (SP := SP +1) >= PSTACKSIZE THEN 
CALL FATALSERROR( “SO” ); 
VALUE(SP) = 03 /* CLEAR VALUE STACK */ 
END INCSP; 


LOOKAEEAD: PROC; 
IF NOLOOK THEN 
DO; 
CALL SCANNER; 
IF TOXEN = 2 THEN FILESDESCSFLAG = 
NOnOOK =<6aALS 85 
IF PRINTSTOKEN THEN 
nO; 
CALL CRLF} 
CALL PRINTSNUMBER (TOKEN); 
CALU PRINT sich AR ( - ~.)5 
CALL PRINTSACCUM; 
END; 
END3 
END LOOKAHEAD; 


NOSCONFLICT: PROC (CSTATE) BYTE; 
men (CSTATE,!,3,X) BYTE? 
m= INDEXi(CSTATE)}; 
K = J + INDEX2(CSTATE) - 13 
mor = J TO X; 
IF READ1(I) = TOKEN THEN RETURN TRUE; 
END} 
RETURN FALSE; 
END NOSCONFLICT; 


RECOVER: PROC BYTE; 
mee (TSP, RSTATE) BYTE; 
DO FOREVER: 
ise = oF 5 
BOGWAILE TSP <> 259; 


IF NOSCONFLICT(RSTATE s= STATESTACK(TSP)) THEN 
DO; /* STATE WILL READ TOKEN */ 


TRUES 


PeeSrPOtonetnEN SP = TSP = 1; 


RETURN RSTATE; 
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END; 
[TSP =eier —- 1; 
END; 
CALL SCANNER; /* TRY ANOTHER TOKEN *¥/ 
END; 
END RECOVER; 


ENDSPASS: PROC; 
/* THIS PROCEDURE STORES THE INFORMATION REQUIRED BY 
PASS2 IN LOCATIONS ABOVE THE SYMBOL TABLE. THE 
FOLLOWING INFORMATION IS STORED: INPUT BUFFER POINTER, 
OUTPUT FILE CONTROL BLOCK, COMPILER TOGGLES */ 
GALL BYTESOUT(SCL); 
CALL ADDRSOUT(NEXTSAVAILABLE) ; 
morn MOVE(.DISPLAY(1),-.LINESCTR(@),5); 
OUTPUTSPTR = OUTPUTSPTR - .OUTPUTSEUFF; 
MmestoPTR = LISTSPTR — .LISTSBUFY; 
CALL MOVE(.DEBUGGING,MAXSMEMORY - PASS1SLEN,PASS1$LEN) 5 
me CO TO L;3 /* PATCH TO JMP @ROCOE */ 
END ENDSPASS; 


ee CUCU C6CUMPROGRAM UBXECUTION STARTS HERE * * ¥* *® */ 


CALL MOVE(INITIALSPOS ,MAXSMEMORY ,RDRSLENGTE); 
CALL INITSSCANNER; 
CALL INITSSYMBOL; 


f% x xO x MK PARSER * *% xx en a7 


DO WHILE COMPILING; 
IF STATE <= MAXRNO THEN /* READ STATE */ 
DO; 
CALL INCSP; 
STATESTACK(SP) = STATE; /* SAVE CURRENT STATE */ 
CALL LOOKAHEAD; 
I = GETIN1I3 
J =e CRTING - 13 
D0) St GeO) ae 
IF READI(I) = TOKEN THEN 
DO; 
/* COPY THE ACCUMULATOR IF IT IS -AN 
INPUT STRING. IF IT IS A RESERVED 
WORD IT DOFS NOT NEED TO BE COPIED.*/ 
IF (TOKEN = INPUTSSTR) 
OR (TOKEN = LITERAL) THEN 
DO K = @ TO ACCUM(@);3 
VARC(K) = ACCUM(K); 


END; 
Sire = READ2Z( 1)? 


NOLOOK = TRUE; 
I = J; 
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END; 
hice fr 1 =a TEEN 

DO; 
CALL PRINTSERROR( “NP” )3 
CALL PRINT(.(% ERROR NEAR $”))3 
CALL PRINTSACCUM;3 
IF (STATE := RECOVER) = @ THEN 

COMPILING = FALSE; 
END; 
BND eon 1. fo J; */ 
END; /* END OF READ STATE */ 
BLUSE IF STATE > MAXPNO THEN /* APPLY PRODUCTION STATE */ 


DO; 
MP = SP - GETIN2;3 
MPP1 = MP + 13 
CALL CODESGEN(STATE -— MAXPNO); 
SP = MP; 
Pen ry Ins 
J = STATESTACK(SP); 
DOeMET DE Umer = APPLY1(1)) <> @ AND J <> K3 

c=") eae 

END; 
IF (K := APPLY2(I)) = @ THEN COMPILING = FALSE; 
Sein = K} 

END; 

ELSE IF STATE <= MAXLNO THEN /*LOOKAHEAD STATE*/ 

OK 
I = GETIN1}3 
CALL LOOKAHEAD; 
DO WHILE (K := LOOK1(I)) <> @ AND TOKEN <> K; 

i= ee ee 

END; 
STATE = LOOK2(I);3 

END; 

ELSE 


DO; /*PUSH STATES */ 
CALL INCSP; 
STATESTACK(SP) = GETIN2; 
STATE = GETIN1; 
END; 
END; /* DO WHILE COMPILING */ 
CALL ENDSPASS; 
END; 
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COMPUTER LISTING FOR MODULE PART TWO NPS MICRO-CO2PBOL 


$ TITLE( “NPS MICRO-COBOL COMPILER PART 2°) PAGEWIDTH(8@) 


PAGEWIDTH(6€@) 
PART2: DLO; 


/* MODULE NAME */ 


fe COSOR COMPILER — PART 2 a7 


T= MODULE LOCATED AT 13H oy 


a GLOBAL DECLARATIONS AND LITERALS i 


DECLARE DCL 


LITERALLY 


“DECLARE’, 


ELT Loney  LLRERALLY 3 

BCL FALSE bee “O", 
ALPHASLITSFLAG BYTE TNE TRAE (FALSE), 
CR Ee Se 
RRROR BYTE DeRTAL( FARS!), 
FOREVER gk “WHILE TRUE’, 
IFSFLAG BYTE tite A Creo sy ) 
LF Laer alee. 
MAXSMEMORY ADDRESS INITIAL(@319027), 
PASS1SLEN ADDRESS TT MIA GOS). 
PASS1$TOP ADDRESS INITIAL( @BO@@Z), 
POUND ler ODO H a: 
PROC LIT “PROCEDURE’, 
SVOTE ot "27H", 
TRUE GET oa ss 

DCL MAXLNO LIT “179°, /* MAX LOOK COUNT */ 
MAXPNO LIT “196°, /* MAX PUSH COUNT */ 
MAXRNO LIT °136°, /* MAX READ COUNT */ 
MAXSNO LIT °345’%, /* MAX STATE COUNT */ 
PRODNO LIT °149°, /* NUMBER OF PRODUCTIONS */ 
STARTS Lit “1°, /* START STATE */ 
ENDC LIT ’22°, /* END */ 
FOFC Prieto /* eon */ 
PROCC LIT °€0°, /* PROCEDURE */ 
TERMNO LIT °81°3; /* TERMINAL COUNT */ 


DCL READ1(*) BYTE 
DATA(2,88,14,15,28,26,28,32,34,36 ,38,44,45,54,55,57,58,64 
Meee 70.7 5 7? 50546, 41,60,00,0¢4,7,41,68, 78,41,6¢6,42,41 
fe e9 52 ,63,76,25,48,61 ,47 , 25,41 ,42,49,50,65,16,1,53,35 
Mem 74,1 472,55 45,96, 09,2519,11,51,46,66,68,81,14,15,28,26 
Meee 400 04,506,608 44, 54,55 ,57 ,58,64,65,69 ,72,75,77 lo, ic 
mero, 51 ,5,8,41,52,66,75,78,21,6,21,11,71,68,67,71,62,71 
»1,27,59,59,18,24,18,41,60,63,12,22,67,14,28, 26, 28,32,34 
,08,44,54,55,57,58,64,65,69,76,75,77,29,41,64 ,63,29,67,1 
mip 15,20 ,26,28,52, 04,06 ,58 ,44 54,55, 57,58, 64,65,69,72 
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DCL 


DCL 


DCL 


DCL 


DCL 


wegen aoe 1415.17.20 ,26,°8,62 ,35,24,26,38,44 54 
655,57 ,58,64,65, 69, 70, 75,77 17 63,79 52 419,62 ,37 40,41 ,42 
,49,58,63,6,9,3,41,42,49,50,63,0,9)3 

LOOK1 (*) BYTE 

DATA(G,19 ,€3,0,63,2,3,0,58,0,63,79,8,62,2,43,56,0,3,0,39 
Mo 5 ,8.0,5,8.0,5-08.0,5,.58 0,41 52,62 ,75,0,21,0,21,2, 
mae. '71,0,60,71,0,60,71,0,71,0,71,9,71,9,71,0,71,9,2,18 
mite 24 31 ,46,66,68,81,0,26,48 ,61,0,12,¢,12,0,12,8,53 ,8,67 
es, 0,55,08,27,59,0,4,7,0,62,2,17,0,66,2,57,0,48,41 ,42 
,49,58,63,0,19,62,9);3 

APPLY1 (*) BYTE 

ma 2.0 ,115,0,19,0,70,128,0,08,134,%,71,195,112,119,123 
,130,8,9,9,09,133,9,9,127,9,9,9,8,9,71,119,123,89,71,9,2 
,105,110,130,0,0,0,6,8,7 ,8,18,11,0,9,12,0,15,8,105,110 
,130,0,41 ,0,4,21,9,25,0,89,9,%,88,90 ,91 ,92,93,94,95,96 ,9,2 
mo ,2,€0,114,8,2,0,0,0,192,9,16,17,22,23, 2&,30,47,48,49 
Rego) .52,57,66,0,0,2,16,17,19 , 22,26 427 28,30, 34,087,359, 48 
be 4c 44 45 ,47,48,49,57 ,.51,52,54,55,57, 62,66 ,115,116,122 
M5 .126,128,132,133,0,6,7,8,9,19,11,12,14,15,18,24,29 ,46 
59 ,68,81 ,192,111 ,8,16,17,22,23,28,39,44,47,48,49,58,51 
,52 557 66,0 ,0,0,26,0,8,21,53,104,1351 ,9,0,9,2)3 

READ2 (*) ADDRESS 

Pera (2.63 ,19,345,24,26,138 ,31 ,33 ,354,36,39,40,43,44,45,45 
ma2,55 ,54,55,59,60,321,6,3529,139,252,6,7,1%,329,129,218 
159, 350 » 029» 30S, 550, 905,139,249 522 .329,3521,3513,381 
339 354,336 ,335,338, 20, 206,42 ,319,325,140,127 ,56,5,317 
9919 ,37,296 ,295, 297,292, 294,292 ,287 ,288 ,19,345, 24,26 128 
Bem o2 ,55 04,356,359, 40,44,45,4€ 52,53,54,55,59,69,18,16,352 
Mee 2o4 9 .12,329, 41,139.57 ,61 ,25,286,25,14, 298,49 ,50,298 
Wem 298) ,2 .250 , 247, 246,23,298 ,22,3829,47,129,15,303,712,19 
eo, 132,51,335,56,39 ,40,44,45,46 ,52,53,54, 55,59 ,69,28 
feo .48,1359,29,3512,267, 208,19, 345 ,24,26,138,21,23,34,36 
mooe4s 44 .45,46,52,56,54,55,59,60,8,11,8,276,11,19,245,21 
928), 26,138,501, 352 3595 4_ 55,39, 43, 44,45 ,46, 52 ,53,54,55,59 
feo, 21 ,926,62,41,197 526,35 38, 329,354,266 ,365,139,228 13 
M29 .554,5056,025,159,%,8)3 

LOOK2 (*) ADDRESS 

DATA(@ ,204,204,3,27,18U,326,327 ,58,181 ,202 ,222,220,66,182 
,67 ,67 ,183,68,324,69,184,76,76,2€5,77,77, 268, 78,78,269,79 
»79,266,80,80,267, 81,81,81,81,1E5,8&3,260 ,85,261,87,186 ,&8 
,187 ,90,90,188,91,91,189,92,199,93,191 ,94,192,95,192 ,96 
»194,195,195,195,101,195,195 ,195,195,195,284,102 ,122,122 
25,196,272 107,271,108 272,113 ,196,114,216,115,239,116 
»251 ,248,248,119,120,120,260,122 ,215,124,228,125,198 ,129 
Oger 51 61351 ,1351 .131,131,131,217 ,205, 205,134); 

APPLY2 (*) ADDRESS 
DATA(@,9,214,97,126,176,128,203 ,202 179,118,117, 306,244 

» 245,307, 306,243 , 209,174,178 ,164,171 ,178, 224, 236, 235 ,112 
»127,72,249,308,309,306,219,99,98,71,213, 213, 213,177,123 
,111,121,173 ,147,149,148 ,150,146 ,166,167,165,274,273,216 
216,216 ,169,175,123,84,153,152,283 ,282,285,78,194,252 


i 
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DCL 


DCL 


25%, 256 , 258,259, 254, 255,257,251 ,225,118,211,172,151,105 
eee iscne7o,e2,o14,135,162,e9,157,154,222,158,156,155 
,159,16@,161,162,86,239,304,212,319,64,144,144,141,144 
,144,342,144 144,344, 318,226 ,142, 208 143,144,277 ,144,144 
Rp 44 144.144 ,145, 278,144,221,144,2353,2355, 227 , 291,281 
Mee oer Co, 2 ome, 275,279 205,275,205, 275,275,242 
Weer 75, 74 265, Foy cOe, 204, 240 325 Seay Clo Oe ey OLE yaee 
NS2S 328 9 32S 9 828 y 820 9 O05 520 9025 9020 028,135,168 ,3357 ,541 
, 300,180 ,228,289,229,1635,219,109,136); 

INDFEX1 (*) ADDRESS 

DATA(@,1,293 ,2,217,23, 28, 24,24 24,24, 24,24,27, 28, 24,2083 
203 34,208 555,217,283, 203 , 54,217 36,205,203, 24, 205,37 ,42 
943,203 ,46,47, 202,53, 203,203,217, 705,203,203, 203 34,283 
9298 , 203,205,293, 203,357 205,205 ,54,203,55, 34, 54, 56,203 ,58 
59,61 ,203,62,61,64,65,73, 94,95,97,98,949,99,99,99,99 ,181 
mg 5-106 .107 .106,199,119,110,111 ,112,114,114,118,1198,112 
mie 16.117,119,120,121 ,43,122,37,129,126,126,126,127 
mon 147 151 .55,152,205,205 ,153 ,154,155,175,177,2<02,18¢ 

, 202,203,203 ,205, 206, 208,129,209,2803,202,2,215,217,1.4,6 
Were 15,15,18,29,22,29,26,41,54,37 ,42, 44,46,48,50,535,56 
,58,60,62,64,66,76,80,82,84 ,86 ,88 ,98 ,92 ,94,97 108,182 ,164 
» 9196 ,108,115,343 ,199,395,315 ,211 , 237,299, 299,299, 299,299 
9299 299,299,299, 291,199 ,1,2,2 54445665747 47,9,9,18,19,10 
Beets t2nte.12,12,.12,12,12,12,12,12,12,12,19,19,20,26,21 
Bonie2 22 24,24, 24, 24, 25,27, 28 29,30, 31 ol zl Ol el yoga 
pO? SE OB 458 438,58, 56 438,508,358 ,58,42,42,43,43,44,44,44,44 
» 44,46 ,46 ,46,51,51,54,54,56,56 ,56 ,60,69,62,62,65,65,65,67 
,67 ,67 ,68 ,68,69,69,69,69,69,69,74,72,79,79,8F ,84 ,81,81 ,82 
»82,82,82,83, &3, 84, 86,57 ,87 ,88 ,68,89,89,93,93,92,92,92 

, 107,128 ,145 ,145 ,145,164,180,180,181,182, 182,182,184 ,184 
,»184,185,185,190,198,191,192); 

INDEX2 (*) BYTE 

meen. 1,1,21,6,1,5,595rSsa00 
isi ,l» 
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/* END OF TABLES */ 


DECLARE 


/* JOINT DECLARATIONS */ 
/* THE FOLLOWING ITEMS ARE DECLARED TOGETHER IN THIS 
GROUP IN ORDER TO FACILITATE TPEIR BEING PASSED FROM 
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THE FIRST PART OF THE COMPILER. 
ed 


DEBUGGING BYTE, 
ERRORSCTR(5) BYTE, 
LINESCTR(S) BYTE, 
LISTSBUFF(128) EXGEE 
LISTSFCB(32) ELLE, 
imo lSINPUT BYTE, 
Pio LSPTR ADDRESS, 
MAXSINTSMEM ADDRESS, 
NEXTSAVAILABLE ADDRESS, 
NEXTSSYM ADDRESS, 
NOSCODE BYTE, 


OUTPUTSBUFF(128) BYTE, 
OUTPUTSFCB(335) Elel ie. 


CUTPUTSPTR ATDRESS, 
POINTER ADDRESS, 
PRINTS PROD BYTE, 
PRINTSTOKEN Ir es 
SEQSNUM BYTE, 
WRITESLST BYTE, 


HASHSTABRSADDR ADDRESS, /* ADDRESS OF THE BOTTOM OF 
THE TABLES FROM PARTI ¥/ 


/* I 0 BUFFERS AND GLOBALS ¥*/ 


INSADDR ADDRESS INITIAL (8CB#), 
INPUTFCB BASED INADDR (33) BYTE, 
LISTSCHAR BASED LISTSPTR BYTE, 
LISTSEND ADDRESS, 

OUTPUTSCHAR BASED OUTPUTSPTR RYTE, 
OUTPUTSEND ADDRESS; 


/* GLOBAL PROCEDURES */ 


DECLARE 
tim BYTE, 
ASCTR ADDRESS; 


MON1: PROC (F,A) EXTERNAL; 
Dem F BYTE, vAi ADDRESS; 

END MON1;3 

MON2: PROC (F,A) BYTE EXTERNAL; 
om F BYTE, +A ADDRESS; 

END MON2;3 


BOOT: PROC EXTERNAL; 
END BOOT; 


PRINTSCHAR: PROC (CHAR); 
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DCL CHAR BYTE; 
CALL MON1 (2,CHAR); 
END PRINTCHAR; 


WRITESOUTPUT: PROC (BUFF,FCB); 
DCL (BUFF,FCB) ADDRESS; 
CALL MON1(26,BUFF); /* SET DMA */ 
IF MON2(21,FCB) <> @ THEN 
DO; 
CATE MONDO. .( WRS”)); 
CALL BOOT; 
ND; 
CALL MON1(26,80H); /*RESET DMA */ 
END WRITES OUTPUT; 


WRITESTOSDISK: PROC(CHAR); 
DCL CHAR BYTE; 
IF (LISTSPTR := LISTSPTR + 1) > LISTSEND TEEN 
DO; 
CALL WRITESOUTPUT( .LISTSBUFF, .LISTSFCR2);3 
LISTSere =s GISTSBUFS 
END; 
LISTSCHAR = CHAR; 
END WRITESTOSDISK; 


PRINT: PROC (A)3 
DCL (A,ADDR) ADDRESS,CHAR BASED ADDR BYTR; 
ADDR = A} 
CALL MON1 (9,A)3 
DO WHILE CHAR <> °$’3 
CALL WRITESTOSDISK (CHAR); 
ADDR = ADDR + 13 
END; 
END PRINT; 


CRLF: PROC; 
MADL MON1(9,.(CR,LF,°$’%))3 
END CRLF;3 


DCRLF: PROC; 
CALL WRITESTOSDISK(CR); 
CALL WRITESTOSDISK(LF); 
END DCRLF;3 


INCSCTR: PROC(BASE); 
DCL BASE ADDRESS, CTR BYTE, BSBYTE BASFD BASE (1) BYTE, 
TEN ile SAN 0; 


CTR = 4; 
DO WHILE ae. |; s= BSBYTE(CTR) + 1) = TEN; 
BSBYTE(CTR) = 


PESCTR > g rerN 
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IF BSEYTE(CTR := CTR - 1) = ° * THEN 
BSBYTE(CTR) = °3°3 
END; 
END INCSCTR; 


PRINTSERROR: PROC (CODE); 
DCL CODE ADDRESS,CODEF1(6) ALDDRESS,I BYTE; 
IF CODE = FALSS THEN 


DO; 
font =o TO 5; 
COonil( = 
END; 
los 
END; 
ELSE IF CODE = TRUE THEN 
ros 
it els 
BO wher (1 <> GOAND (CODF1(1) <> 2)); 
CALL PRINTCHAR(HIGH(CODE1(I)));3 
CALL PRINTCYAR(LOW (CODE1(1I))); 
CALL WRITESTOSDISK(HIGH(COLDE1(I)));3 
CALL WRITESTOSDISK(LOW (COTE1{(I)));3 
CAnL wore! 
CALL DCRLF; 
CODE1(I) = @;3 
(ose 1; 
END; 
io 
ERROR = FALSE; 
END} 


Mmesk IF (CODE = “°NP’) OR (CODE = ’NV’) 
On CCODS = SL ) THEN 
DO; 
ERROR = TRUE} 
CALL PRINTCEAR(HIGH(CODE) ); 
CALL PRINTCHAR(LOW (CODE));3 
CALL sWRITESTOSDISK(HIGH(CODE)): 
CALL WRITESTOSDISK(LOW (CODE)); 
CALL INCSCTR(.ERRORSCTR(@))3 
IF CODE <> ’NP’ THEN 
DO; 
Cate GR Ns 
CALL DCRLIF; 
END; 
END; 

mESe DO; 

ERROR = TRUE} 
IF I <> 6 THEN 
DO; 
CODE1i(I) = CODE; 
ie ee 15 
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END; 
CALL INCSCTR(.BRRORSCTR(2) )$ 
END; 
END PRINTSERROR; 


FATALSERROR: PROC(REASON)3 
DCL REASON ADDRE#SS; 
CALL PRINTSERROR (REASON); 
CALL PRINTSERROR(TRUE); 
GALL BOOT; 

END FATALSERROR; 


CLOSE: PROC(FCB); 

DCL FCB ADDRESS; 

IF MON2(16,FCB) = 255 THEN CALL FATALSFRROR(‘CL’)3 
END CLOSE; 


MORESINPUT: PROC BYTE} 
Het DCNT BYTE; 
IF (DCNT := MON2(20,.INPUTSFCE)) > 1 THEN 
CALL FATALSERROR( ’BR’); 
RETURN NOT(DCNT)3 
END MORESINPUT; 


MOVE: PROC(SOURCE, DESTINATION, COUNT); 
DCL (COUNT,SOURCE,DESTINATION) ADDRESS, 
(SSBYTE BASED SOURCE, DSBYTE BASED DESTINATION) BYTE; 
DO WHILE (COUNT := COUNT ~ 1) <> OFFFFH; 
DSBYTE = SSBYTE;S 
SOURCE = SOURCE +1; 
DESTINATION = DESTINATION + 1; 
END; 
END MOVE; 


FILL: PROC(ADDR,CHAR,COUNT); 
DCL (ADDR,COUNT) ADDRESS, 
(CEAR,DEST BASED ADDR) BYTE; 
DO WHILE (COUNT := COUNT - 1) <> @FFFFE; 
DEST=CHAR; 
ADDR=ADDR + 13 
END; 
END FILL; 


/* ee Se OCANNER@Ghhe = * *  */ 


DECLARE 
INPUTSSTR Lir "63", 
INVALID eptiele “O°, 
LITERAL rT ae 
LPARIN fen oS. 
PERIOD er Bia. 





RPARIN ie oa; 
fx * * *% * SCANNER TABLES * * * * = %*/ 


DCL TOKENSTABLE (*) BYTE DATA 
/* CONTAINS THE TOKEN NUMBER ONE LESS THAN THE FIRST 
RESERVED WORD FOR EACH LENGTH OF WORD */ 
mero ,12,18,25,42,594,65,75,77,89), 


pei) BYTE DATA( BY’ ,°GO’, IF’, NO’,°OR’, TO’, EOP’, ADD’ 
mand. ND , I-0°, NOT’, RUN’, CALL”, ELSE”, EXIT’ 
>» FROM’, INTO’, LESS’, MOVE’, NEXT’, OPEN’, ‘PAGE’, “READ’ 
meozm , STOP , THRU , WITH , ZERO’, AFTER’, CLOSE’ 
, ENTER’, ‘EQUAL’, ERROR’, INPUT’, QUOTF’, TIMES’, “SPACR’ 
merpndiL , OSING , WRITE , ACCEPT’. BEFORE’, DELETE’ 
meDIvVIDE’, PEND<IF°, GIVING” . OUTPUT’, COMPUTE’, DISPLAY’ 
» GREATER’, “INVALID’, ‘NUMERIC’, ° PERFORM’, REWRITE’ 
merOUNDED , SECTION’, VARYING’, DIVISION’, “MULTIPLY ’ 
» SENTENCE’, ‘SUBTRACT’, “ADVANCING ’, “DEPENDING “ 
,» PROCEDURE’, “ALPHABETIC’), 
OFFSET (11) ADDRESS INITIAL 
/* NUMBER OF BYTES TO INDFX INTO THE TABLF FOR EACZ 
LENGTE */ 
Meee ,% 12 ,355,97,157,199,269,501,328), 


WORDSCOUNT (*) BYTE DATA 
/* NUMBER OF WORDS OF EACH SIZE */ 
ro .6 7,16, t207,1¢0,4,371), 


ACCUM(&2) BYTE, 

ADDSEND(*) RYTE yA A fOr.) 
BUPFERSEND ADDRESS INITIAL(19@H), 

CHAR - BYTE COU ak 4 seein 
DISPLAY(88) RYTE INITIAL(@), 
FOFFILLER it “1 BH’, 

FIRSTSLINE BYTE PVGrLAr I Roe) . 
FORMFEFD itr aOGrlo. 

FOLD BYTE, 

INBUFF Lit “B3H’, 

LOOKED BYTE INITIAL(G2), 
MAXSIDSLEN LIT Sioa 

MAXSLEN Lee ae. 

NEXT BASED POINTER BYTE, 

TAB tT 709°, 

TOKEN BYTE; /*RETURNED FROM SCANNER */ 


/* PROCS USED BY THE SCANNER */ 
NEXTSCHAR: PROC BYTE; 


IF LOOKED THEN 
C0; 
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MOCK) Ss lahngik 
RETURN (CHAR := HOLD); 
END; 
IF (POINTER := POINTER + 1) >= BUFFERSEND THEN 
oF 
IF NOT MORESINPUT THEN 
DO; 
BUFFERSEND = .MEMORY; 
POINTER = .ADDSEND3 
END; 
ELSE POINTER = INBUFF; 
END; 
IF NEXT = EOFFILLER THEN 
DO} 
BUFFERSEND = .MEMORY; 
POINTER = .ALDDSEND; 
END} 
RETURN (CHAR := NEXT); 
END NEXTSCHAR; 


GETSCHAR: PROC; 
CHAR = NEXTSCHAR; 
END GETSCHAR; 


DISPLAYSLINE: PROC; 
WoL {I BYTE; 
Boy] = 1 TO DISPLAY(@); 
IF LISTSINPUT OR ERROR THEN 
CALL PRINTSCHAR(DISPLAY(I)); 
IF WRITESLST OR ERROR THEN 
™ CALL WRITESTOSDISK(DISPLAY(I));3 
END} 
IF FIRSTSLINE THEN 
DOs 
CALL MOVE(.LINESCTR, .DISPRAY(1),5);3 
FIRSTSLINE = FALSE; 
END} . 
ELSE CALL INCSCTR(.DISPLAY(92))3 
MrsPLAY(@) = 5; 
END DISPLAYSLINE; 


LOADSDISPLAY: PROC; 
IF DISPLAY(@) < 87 TEEN 
DISPLAY(DISPLAY(@) := DISPLAY(@) + 1) = CBAR; 
CALL GETSCHAR; 
END LOADSDISPLAY; 


PUT: PROC; 
IF ACCUM(@) < &1 THEN 
ACCUM(ACCUM(@) s= ACCUM(@) + 1) = CHAR; 
CALL LOADSDISPLAY} 
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END PUT; 


EATSLINE: PROC; 
DO WHILE CHAR <> CR; 
CALL LOAD$SDISPLAY; 
END; 
END EATSLINE; 


GETSNOSBLANK: PROC; 
DCL I BYTE; 
DO FOREVER} 
IF CHAR = ° * OR CHAR = TAB THEN CALL LOADSDISPLAY; 
ELSF IF CHAR=CR THEN 
DO; 
CALL LOADSDISPLAY; 
CALL LOADSDISPLAY; 
CALL DISPLAYSLINS; 
CALL PRINTSERROR( TRUE) 
DO WHILE CHAR = CR; 
CALL LOADSDISPLAY; 
CALL LOADSDISPLAY; 
CALL DISPLAYSLINE; 
END; 
IF SEQSNUM THEN 
pom = 1 TO 6; 
CALL LOADSDISPLAY; 
END; 
IF CHAR = °*° THEN CALL FATSLINE; 
ELSE IF CHAR = ’/” TEEN 
DO; 
IF LISTSINPUT THEN 
CALL PRINTSCHAR(FORMSFEED); 
IF WRITESLST THEN 
CALL WRITESTOSDISK (FORMSFEED); 
CALL FATSLINE; 
END; 
ELSE IF CHAR = ’:” TEEN 
IF NOT DEBUGGING THEN CALL RFATSLIN®; 
ELSE CALL LOADSDISPLAY; 
END} 
ELSE RETURN; 
END; /* END OF DO FOREVER */ 
END GETSNOSBLANK3 


SPACE: PROC BYTE; 


RETURN (CHAR = ° ~) OR (CHAR = CR) OR (CHAR = TAB)? 
END SPACE; 


LEFTSPARIN: PROC BYTE 
RETURN CHAR = “(’ 
END LEFTSPARIN} 


e 
y 
e 
’ 
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RIGHTSPARIN: PROC BYTE; 
RETURN CHAR = “)’3 
END RIGHTSPARIN; 


DELIMITFR: PROC BYTE; 
IF CHAR <> °,° THEN RETURN FALSE; 
FOLD = NEXTSCHAR} 
LOOKED = TRUE; 
IF SPACE TEEN 
DO; 
CHAR = ~. ; 
RETURN TRUE; 
END} 
GPAR = *.°3 
RETURN FALSS;3 
BaD DELIMITER; 


ENDSOFSTOKEN: PROC BYTE; 
RETURN SPACE OR DELIMITER OR LEFTSPARIN OR RICETSPARIN; 
END ENDSOFSTOKEN; 


meeoLITERAL: PROC BYTE; 
CALL LOADSDISPLAY; 
DO FOREVER; 
IF CHAR = QUOTE THEN 
DQ; 
CALL LOADSDISPLAY; 
RETURN LITERAL; 
END; 
CALL PUT; 
END; 
END GETSLITERAL; 


LOOKSUP: PROC BYTE; 
en POINT ADDRESS, 
HERE BASED POINT (1) BYTE, I BYTE; 


MATCH: PROC BYTE; 
BOL J BYTE; 
Dome 1 TO ACCUM( GC); 
IF HERE(J - 1) <> ACCUM(J) THEN RETURN FALSE; 
END; 
RETURN TRUE} 
END MATCS; 


POINT = OFFSET(ACCUM(®@)) + .TABLE; 
DO I = 1 TO WORDSCOUNT(ACCUM(@));3 
I® MATCH TSEN RETURN I3 
POINT = POINT + ACCUM(2);3 
END; 
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RETURN FALSE; 
END LOOKSUP; 


RESERVEDSWORD: PROC BYTE; 
DCL (NUMB,VALUE) BYTE; 
IF ACCUM(@) <= MAXSLEN THEN 


DO; 
IF (NUMR := TOKENSTABLE(ACCUM(@))) <> @ THEN 
IF (VALUE := LOOKSUP) <> @ TEEN 
NUMER = NUMB + VALUE; 
ELSE NUME = @;3 
END; 


ELSE NUMB = @; 
RETURN NUMB; 
END RESERVEDSWORD; 


GETSTOKEN: PROC BYTE} 
ACCUM(@) = 23 
CALL GETSNOSBLANK; 
IF CHAR = OUOTE THEN RETURN GETSLITERAL; 
IF DELIMITER THEN 
DO; 
CALL PUT; 
RETURN PERIOD; 
END; 
IF LEFTSPARIN THEN 
DO; 
CALL PUT; 
RETURN LPARIN; 
END; 
IF RIGHTSPARIN TEEN 
DO; 
CALL PUTS 
RETURN RPARIN; 
END; 
DO FOREVER; 
CALL PUT; 
IF ENDSOFSTOKEN THEN RETURN INPUTSSTR;} 
END; /* OF DO FOREVER */ 
oD GETSTOXEN; 
/* END OF SCANNER ROUTINES */ 
/* SCANNER EXEC */ 
SCANNER: PROC} 
IF(TOKEN := GETSTOKEN) = INPUTSSTR THEN 
IF (CTR := RESERVEDSWORD) <> @ THEN TOKEN = CTR; 
END SCANNER} 


PRINTSACCUM: PROC; 
Mer I BYTE; 
mel = 1 TO ACCUM(Q); 
CALL PRINTSCHAR(ACCUM(I))3 





Cte wh TeStOsbISkK(ACCUM(1)); 
END; 
CALL CRLF; 
CALL DCRLF; 
END PRINTSACCUM; 


PRINTSNUMBER: PROC(NUMB); 
DECLARE(NUMB,I,CNT,K) BYTE, J (*) BYTE DATA(1@0,1@);3 
mel = @ TO 1} 
cio) 
DO WHILE NUME >= (K% := J(I)); 
NUMB = NUMB — K; 
tne = CNT = 1; 
ENDS 
CALL PRINTCPAR(“@” + CNT)3 
END; 
CALL PRINTCBAR(°@” + NUMEB);3 
END PRINTSNUMBER; 
je * * * END OF SCANNER PROCS * * * = #/ 


ees OYMPOL TABLE DECLARATIONS * * * #/ 
DECLARE 


CURSSYM ADDRESS, /J*SYMBOL BEING ACCESSED*/ 
DECIMAL eer ies 
DISPLACEMENT CLT pea 

FCBSADDR bit ene, 

FLDSLENGTE BIT ae 

HASHSMASX DUBE TEER 

LEVEL Tic CG. 

LOCATION et Got 

PSLENGTE mut Boies 

RELSID ICG gon 

SSTYPE ICSE Woe: 

STARTSNAME eee cmt bso 
SYMBOL EMSEDMONRSSYM Ul)" BYTE, 
SYMBOLSADDR PASED CURSSYM (1) ADDRESS, 
TEMPSPTR ADDRESS, 

TEMPSADDR BASED TEMPSPTR ADDRESS, 


moe ee = SYMBOL TYPE LITERALS * * * ¥* * ¥ */ 


ASED Bit a2. 
ASNSED ler AZo 
ALPHA Ger =e 
ALPHASNUM Tea aCe 
COMP ay meek 
GROUP iter ioe 
LARBELSTYPE Ik C52. 4 
LITSQUOTE aan glee 
LITSSPACE eT 220... 
LITSZERO Een eye . 
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MULTSOCCURS ey lz 


NONSNUMERICSLIT LIT oe 
NUMSED as eo", 
NUMERIC Ear mle. 
NUMERICSLITERAL ier oie 
UNRESOLVED ra q255\ 5 


ye « * * SYMEOL TABLE ROUTINES * * * */ 


SETSADDRESS: PROC(ADDR); 

DCL ADDR ADDRESS}; 
SYMBOLSADDR(LOCATION) = ADDR; 

END SETSADDRESS 3 


GETSADDRESS: PROC ADDRESS; 
RETURN SYMBOLSADDR(LOCATION) ; 
END GETSADDRESS; 


GETSFCBSADDR: PROC ADDRESS; 
RETURN SYMBOLSADDR(FCBSADDR) ; 
END GET$SFCBSADDR; 


melo’ PE: PROC BYTE; 
merURN SYMBOL(SSTYPE)>; 
END GETSTYPE; 


memo tiPE: PROC(TYPE); 
DCL TYPE BYTE; 
SIMBOL(SSTYPE) = TYPE; 
END SETSTYPE; 


GETSLENGTH: PROC ADDRESS} 
RETURN SYMBOLSADDR(FLDSLENGTH) ; 
END GETSLENGTH; 


GETSLEVEL: PROC EYTE; 
RETURN SYMBOL(LEVEL); 
END GETSLEVEL; 


GETSDECIMAL: PROC BYTE; 
RETURN SYMBOL(DECIMAL); 
END GETSDECIMAL; 


GETSPSLENGTH: PROC EYTE;} 
RETURN SYMBOL(PSLENGTH); 
END GETSPSLENGTS; 


BUILDSSYMBOL: PROC(LEN)} 
DCL LEN BYTE, TEMP ADDRESS; 
TEMP = NEXTSSYM; 
IF (NEXTSSYM := .SYMBOL(LEN := LEN + DISPLACEMENT) ) 
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S MAXSMEMORY TEEN CALL FATALSERROP( ‘ST’); 
BALL FILL (TEMP,2,LEN); 
END BUILDSSYMBOL; 


GETSPREVSCCCURS: PROC ADDRESS; 
TEMPSPTR = CURSSYM + DISPLACEMENT + GETSPSLENGTS; 
RETURN TEMPSATODR; 

END GETSPREVSOCCURS; 


ANDSOUTSOCCURS: PROC (TYPESIN) BYTE; 
DCL TYPESIN BYTE; 
RETURN TYPESIN AND 1273 

END ANDSOUTSOCCURS; 


CHECKSUNRESOLVED: PROC; 
DCL (1,J) BYTE,PTR ADDRFSS,ADDRSPTR BASED PTR ALTDRESS; 
PTR = HASHSTABSADDR3/*SET PTR TO FIRST BASH ADDR*/ 
emt = 1 TO 643 
IF ADDRSPTR<>O THEN 
DO; 
CURSSYM = ADDRSPTR} 
DO WHILE CURSYM<>@;3 
IF GETSTYPE = UNRESOLVED THEN 
Den 
Ghit PRINE(.( UL S-))3 
Bor = 120 CEmSPSLENGTT; 
CALL PRINTSCERAR(SYMBOL(STARTSNAME + J))3 
CALL WRITESTOSDISK(SYMBOL(STARTSNAME + J))3 
END; 
CALL CRLF; 
CALL DCRLF; 
CALL INCSCTR( .ERRORSCTR(2)); 
Kini 
CURS YM 
END; 
END; 
PTP = PTR + 23 
END; 
END CHECKSUNRESOLVED; 


SYMBOLSADDR(@); 


foe-l€C<C SC‘ YCUPARSER DECDARATIONS * * * ¥/ 


DCL 

COMPILING Eon INITIML(TRUE), 
CONSLENGTY BYR. 

CONDSTYPE Bee. 

DISPLAYSFLAG ae) PNOTIAL( FALSE), 
HOLDSSECSADDR ADDRESS, 

HOLDSSECTION ADDRESS, 

IDSPTR BYT:, 

IDSSTACK(2@) ADDRESS, 
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foes ,X) 


ADDRESS, /*INDICIES FOR THE PARSER*/ 


LSADDR ADDRESS, 
LSDEC BYTE. 

LSDECSTEMP RYTE, 

LSLENGTE ADDRESS, 

LSTYPE BYTE, 

MP BYTE, 

MPP1 BYTE, 

NEXTSADDRESS ADDRESS INITIAL(Q), 

NOLOOK BYTE INITIAL(FALSE), 
PSTACKSIZE GET or ys iZ® OF STACKS*/ 
SECTIONSFLAG BYTE INITIAL(@), 

SP BYTE INITIAL(255), 

STATE ADDRESS CEA STARTS ) , 
STATESTACK(PSTACKSIZE) ADDRESS, /* SAVED STATES */ 
SUBSIND RYTE INITIAL(2), 

VARC(1@@) BY DE /*TEMP CHAR STORE*/ 
VALUE(PSTACKSIZE) ADDRESS, /* TEMP VALUES */ 
VALUF2(PSTACKSIZE) ADDRESS, /* VALUE2 STACK */ 
WRITESBEFORE BYTE PNR WAMEL HALS ©), 
WRITESAFTER BYTE CNT DLL PADS Ee), 


ADD 
SUB 
MUL 
DIV 
NEG 
STP 
STI 
EXT 


RND 


RET 
CLS 
SER 
BRN 
OPN 
OPi 
ere 
RGT 
RLT 
REQ 
INV 
KOR 


fe RH KW KR MN X CODE LITERALS * * *% *% *% % HK OK OK KS 

/* TEE CODE LITFERALS ARF BROXEN INTO GROUPS DEPENDING 
ON THE TOTAL LENGTHY OF CODE PRODUCED FOR THAT ACTION */ 
/* LENGTH ONE */ 


LIT 
oT 
LIT 
aT 
LIT 
ioe T 
iat 
LIT 
/* 
tT 
/* 
eT 
eT 
at T 
ine T 
LIT 
at 
une T 
LIT 
ca T 
iit 
opt 
LIT 
yx 


oie. /* ADD REGISTER 1 TO REGISTER @ */ 

2. /* SUBTRACT REGISTER 1 FROM REGISTER 2 */ 
gar /* MULTIPLY REGISTER @ BY REGISTER 1 */ 
a /* DIVIDE REGISTER @ BY REGISTER 1 */ 

cae /* NOT OPERATOR */ 

"6°, * STOP PROGRAM */ 

a /* STORE REGISTER 2 INTO REGISTER @ */ 

car /* EXIT SUBROUTINE */ 

LENGTH Two */ 

“9", /* ROUND CONTENTS OF REGISTER 2? */ 

LENGTH THREE */ 

“10°, /* RETURN */ 

on, «0 O6/* CLOSE */ 

“12°, /* BRANCH ON SIZE ERROR */ 

“13°, /* BRANCH */ 

“14°, /* OPEN A FILE FOR INPUT */ 

“15°, /* OPEN A FILE FOR OUTPUT */ 

“16°, /* OPEN A FILE FOR BOTH INPUT AND OUTPUT */ 
17°, /* REGISTER GREATER TRAN */ 

“18°, /* REGISTER LESS THAN */ 

“19°, /* REGISTER EQUAL */ 

“20°, /* BRANCH IF INVALID-FILE-ACTION FLAG TRUE */ 
‘21°, /* BRANCH ON END-OF-RECORDS FLAG */ 


LENGTE FOUR */ 
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PAG LIT ’22’, /* CARRIAGE CONTROL FOR PRINTER OPERATION */ 
mec LIT ~23°, /* ACCEPT */ 
STD LIT °24°, /* STOP WITH DISPLAY */ 
LDDI LIT “25°, /* LOAD A CODE ADDRESS DIRECT */ 
/* LENGTH FIVE */ 
DIS LIT °26°, /* DISPLAY */ 
DEC LIT °’27°, /* DECREMENT COUNT AND BRANCH IF ZFRO */ 
STO LIT °28°, /* STORE NUMERIC */ 
STi LIT °29°, /* STORE SIGNED NUMERIC LEADING */ 
ST2 LIT °20°, /* STORE SIGNED NUMERIC TRAILING */ 
ST3 LIT °31°, /* STORE SEPARATE SIGN LEADING */ 
ST4 LIT °32°, /* STORE SEPARATE SIGN TRAILING */ 
ST5 LIT °33’, /* STORE A PACKED NUMERIC FIELD */ 
/* LENGTH SIX ¥*/ 
LOD LIT °34’, /* LOAD NUMERIC LITERAL */ 
moe LIT “35°, /* LOAD NUMERIC */ 
LD2 LIT °36°, /* LOAD SIGNED NUMERIC LEADING */ 
LPS LIT °27°, /* LOAD SIGNED NUMERIC TRAILING */ 
LD4 LIT °38°, /* LOAD SEPARATE SIGN LEADING */ 
LD5 LIT %°39°, /* LOAD SEPARATE SIGN TRAILING */ 
LD6 LIT °40°, /* LOAD A PACKED NUMERIC FIELD */ 
/* LENGTH SEVEN *¥/ 
PER LIT °41°, /* PERFORM */ 
CNU LIT °42°, /* COMPARE NUMERIC UNSIGNED */ 
CNS LIT °43°, /* COMPARE NUMERIC SIGNED */ 
CAL LIT °44%, /* COMPARE ALPHARETIC */ 
RWS LIT °45°, /* REWRITE SEQUENTIAL */ 
Moe bIT 46°, /* DELETE SEQUENTIAL */ 
RDF LIT °47°, /* READ A SEQUENTIAL FILE */ 
WTF LIT °48°, /* WRITE A RECORD TO A SEQUENTIAL FILE */ 
RVL LIT °49°, /* READ A VARIABLE LENGTH FILE ¥*/ 
WVL LIT ‘°50°, /* WRITE A VARIABLE LFNGTH RECORD */ 
* LENGTH NINE */ 
SepeuiyT 51°, /* CALCULATE A SUBSCRIPT */ 
SGT LIT °52°, /* STRING GREATER THAN */ 
MrebiT “53°, /* STRING LESS TEAN */ 
SFO LIT °54’, /* STRING EQUAL */ 
MOV LIT °55’%, /* MOVE */ 
/* LENGTH TEN */ 
RRS LIT °56”°, /* READ RELATIVE SEQUENTIAL */ 
WRS LIT °57°, /* WRITE RELATIVE SEQUENTIAL */ 
RRR LIT °58’, /* READ RELATIVE RANDOM */ 
WRR LIT °59°, /* WRITE RELATIVE RANDOM */ 
RWR LIT “60°, /* REWRITE RELATIVE */ 
TLR LIT ’61°, /* DELETE RELATIVE */ 
/* LENGTH ELEVEN */ 
MED LIT °’62°, /* MOVE INTO AN ALPHANUMERIC EDITED FIFLD */ 
/* LENGTH THIRTEEN */ 
MNF LIT ‘°63°, /* MOVE INTO A NUMERIC EDITED FIELD */ 
SBR LIT “64°, /* SUBROUTINE CALL */ 
/* VARIABLE LENGTY */ 
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GDP LIT °65’, /* GO TO — DEPENDING ON */ 
PAR LIT ‘°66’, /* PARAMETER LIST */ 

/* BUILD DIRECTING ONLY */ 
mer Lit 67°, /* INITIALIZE MEMORY */ 
BST LIT °’68’, /* BACK STUFF */ 
TER LIT °69°, /* TERMINATE BUILD */ 
eepe LIT 70°; /* STHRT CODE */ 


/* * * * PARSER ROUTINES * * * * */ 
DIGIT: PROC (CHAR) BYTE; 

men, COAR BYTE} 

RETURN (CHAR <= °9”) AND (CHAR D= °0°);5 
mam DIGIT; 


LETTER: PROC (CHAR) BYTE; 

DCL CHAR BYTE} 

MOURN (CHAR >= “Ae ) AND (CHAR <= °2°); 
END LETTER} 


INVALIDSTYPE: PROC; 
CALL PRINTSERROR( “IT’); 
END INVALIDSTYPE; 


BYTESOUT: PROC(ONESBYTE); 
DCL ONESBYTE BYTE} 
IF NOSCODF THEN RETURN; 
IF (OUTPUTSPTR := OUTPUTSPTR + 1) > OUTPUTSEND THEN 
DO} 
CALL WRITESOUTPUT( .OUTPUTSBUFF, .OUTPUTSFCE)} 
OUTPUTSPTR = .OUTPUTSBUFF; 
END} 
OUTPUTSCHAR = ONFSBYTR; 
END RBYTESOUT; 


ADDRSOUT: PROC (ADDR); 
DCL ADDR ADDRESS; 
CALL BYTESOUT(LOW(ADDR) ); 
CALL BYTESOUT(HIGH (ADDR));3 
END ADDRSOUT; 


INCSCOUNT: PROC(CNT)3 
HeL CNT BYTE; 
IF(NEXTSAVAILABLE := NEXTSAVAILABLE + CNT) 
> MAXSINTSMEM THEN CALL FATALSERROR(‘°MO’); 
END INCSCOUNT; 


ONTSADDRSOPP: PROC(CODE,ADDR); 
DCL CODE BYTE, ADDR ADIRESS; 
GALL BYTESOUT(COLE); 

CALL ADDRSOUT(ADDR); 
GALL INCSCOUNT(3); 
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END ONESADDRSOPP; 


MATCH: PROC ADDRESS; 
CCL POINT ADDRESS, COLLISION BASED POINT ADDRESS, 
(HOLD,I) BYTE; 
IF VARC(Q@)>MAXSIDSLEN THEN VARC(@) = MAXSIDSLEN; 
HOLD = @;3 
wont = 1 TO VARC(S); 
HOLD = HOLD + VARC(I)3 
END} 
POINT = HASHSTABSALDDR + SHL( (HOLD AND EASHSMASK),1);3 
DO FOREVER; 
IF COLLISION = 2 THEN 
DO; 
CURSSYM,COLLISION = NEXTSSYM; 
CALL BUILDSSYMRBOL(VARC(2)); 
SYMBOL(PSLENGTE) = VARC(@); 
DOM ale myAr CG CO), 
SYMBOL(STARTSNAME + I) = VARC(I)3 
END} 
CALL SETSTYPE(UNRESOLVED); 
RETURN CURSSYM; 
END; 
ELSE 
DO} 
SOR scr M=sCOminl SION $ 
IF (HOLD: =GETSPSLENGTH)=VARC(Q) THEN 
DO; 
i, 
CO WHILE SYMBOL(STARTSNAME + I)= VARC(I)3 
IF (I:=I+1)>HOLD THEN 
RETURN(CURSSYM := COLLISION); 
FND$ 
END; 
END; 
BON ia= COLLISIONS 
END}; 
END MATCH; 


SETSVALUE: PROC(NUMB); 
DCL NUMB ADDRESS; 
VALUE(MP) = NUMB; 

END SETSVALUE; 


SETSVALUE2: PROC (ADDR)} 
DCL ADDR ADDRESS; 
VALUR2(MP) = ADDR} 

END SETSVALUE2}3 


CHXSUDSVAR: PROC (PTR); 
DCL PTR BYTF; 





CURSYM = VALUE(PTR); 
IF GETSTYPE = UNRESOLVED THEN 
CALL PRINTSERROR( “UD’)3 
END CHKSUDSVAR; 


SUBSCNT: PROC BYTE; 
IF (SUBSIND := SUBSIND + 1) > 7 TEEN 
SURSIND = 13 
RETURN SUBSIND; 
PND SUBSCNT;3 


CODESBYTE: PROC (CODE); 
mon, CODE BYTE; 
CALL BYTESOUT(CODE); 
CALL INCSCOUNT(1); 
END CODESBYTE; 


CODESADDRESS: PROC (CODE); 
DCL CODE ADDRESS; 
GAGL ADDRSOUT(COLE); 
GALL INCSCOUNT(2); 

END CODESADDRESS; 


CONVERTSINTEGER: PROC ADDRESS; 
wel ek BYTR; 
err = OC; 
IF VARC(1) = °+° THEN A = 23 ELSE A = 13 
MorcTR = A TO VARC(@); 
IF NOT DIGIT(VARC(CTR)) TEEN 
DO; 
CALL PRINTSERROR( “NN )3 
RETURN ASCTR; 
END; 
miok ASCTR = SHL(ACTR,2) + SHL(ACTR,1) + 
VARC(CTR) - °O’$3 
END} 
RETURN ACTR}3 
END CONVERTSINTEGER; 


PeGkSTUFF: PROC (ADD1,ADD2); 
DCL (ADD1,ADD2) ADDRESS; 
CALL BYTESOUT(BST); 

CALL ADDRSOUT(ADI1); 
CALL ADDRSOUT(ADD2); 
END BACKSSTUFF; 


CHKSNXTSSENTENCE: PROC; 
IF NEXTSADDRESS <> @ TEEN 
DO; 
CALL BACKSTUFF(NEXTSADIRESS ,NEXTSAVAILAPLE!; 
NEXTSADDRESS = @;3 
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END; 
END CHKSNXTSSENTENCE; 


UNRESSBRANCH: PROC; 
CALL SETSVALUE(NFXTSAVAILABLE + 1); 
CALL ONESADDRSOPP(ERN,@)3 
CALL SETSVALUB2(NEXTSAVAILARBLE); 
END UNRESSBRANCH; 


BACKSCOND: PROC; 
CALL BACKSTUFF(VALUE(SP - 1),NEXTSAVAILABLE); 
END BACKSCOND; 


SETSBRANCH: PROC; 
CALL SETSVALUE(NEXTSAVAILABLE);3 
CALL CODSSADDRESS(@)3 

END SETSBRANCE; 


KEEPSVALUES: PROC; 
GALL SETSVALUER(VALUE(SP 
CALL SETSVALUE2(VALUE2 ( 
END KEEPSVALUES ; 


a 
SP))3 


CARRAGESCONTROL: PROC} 
WRITESBEFORE WRITESAFTER = FALSE; 
CALL CODESBYTE(PAG)3 
CALL CODESADDRESS(GETSFCBSADDR); 
CALL CODESBYTE(VALUE(SP)); 

END CARRAGESCONTROL} 


STDSATTRIBUTES: PROC(TYPE); 
DCL TYPE BYTE; 
CALL CODESADDRESS(GETSFCBSADDR); 
CURSSYM = GFTSADDRESS; 
CALL CODESADDRESS (GETSADDRESS )} 
CALL CODRESADDRESS (GETSLENGTH);3 


Ir TYPE = @ THEN RETURN; 
CURSSYM = GETSFCBSADDR; 
CURSSYM = SYMBOLSADDR(RELSID); 


CALL CODESADDR¥YSS(GFTSADDRESS );3 
CALL CODESBYTF(GETSLENGTH); 
END STDSATTRIBUTES; 


WRITESASRECORD: PROC; 

DCL TEMPSSYM ADDRESS; 

IF GETSLEVEL <> 1 THEN CALL PRINTSERROR( “WL’); 

ELSE 

DO; 

TEMPSSYM = CURSSYM; 
CURSSYM = GETSFCBSADDR; 
IF (CTR := GETSTYPE) <> 1 AND 
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(WRITESBEFORE OR WRITESAFTER) THEN 
CADE ME RINTSERROR( CC”); 
Ir CTR = 1 THEN 
FOG 
IF WRITESAFTER THEN CALL CARRAGESCONTROL; 
CALL CODESRBYTE(WTF) ; 
CALE STDSRTTRIBUTES (OQ); 
IF WRITESBEFORE THEN 
DO; 
CURSSYM = GETSFCESADIBP; 
CALL CARRAGESCONTROL} 
END; 
END; 
Mise fh Clip = 2 THEN 
DO; 
CALL CODESEYTS(¥WRS); 
CMLL STDSATTRIBUTES (1); 
END; 
mess mC TR = 3° THEN 
DO; 
CALL CODESBYTE(WRR);3 
CORE STRSMEERIBUTES (1); 
END; 
ELSE IF CTR = 4 THEN 
DO; 
CALL CODESBYTE(WVL); 
CALL CODESADDRESS(GETSFCBRSADDR) 3; 
CURSSYM = TEMPSSYM; 
CALL CODESADDRESS(GETSADDRESS ); 
; CALL CODESADDRESS(GETSLENGTH); 
END; 
ELSE CALL PRINTSERROR( ’FT’);3 
END; 
END WRITESASRECORD; 


READSASFILE: PROC; 
Mee(CTR := GETSTYPE) = 1 THEN 
DO; 
CALL CODFSBYTE(RDF);3 
CALL STISATTRIBUTES(@);3 
END; 
ELSE IF CTR = 2 THEN 
DO; 
CALE CODSSBITEURRS ); 
CALL STDSATTRIBUTES(1);3 
END; 
misk IF CTR = 3 THEN 
DO; 
CALL CODESBYTE(RRR)3 
CALL STDSATTRIBUTES(1);3 
END; 
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ELSF IF CTR = 4 THEN 
DO's 
CALL CODFSBYTE(RVL); 
CALL CODESADDRESS(GETSFCBSADDR ); 
CALL CODFSADDRESS(GETSLENGTB); 
CURSSYM = GETSADDRESS; 
CALL CODESADDRESS(GETSADDRESS ) 3 
END} 
ELSE CALL PRINTSERROR( “FT’); 
END READSASFILE;3 


ARITHMETICSTYPE: PROC BYTE; 
IF ((LSTYPE s= ANDSOUTSOCCURS(LSTYPE)) d= 
NUMERICSLITERAL) AND (LSTYPE <= COMP) THEN 
RETURN LSTYPE — NUMERICSLITERAL; 
IF LSTYPE = LITSZERO OR LSTYPE = ALPHASNUM TEEN 
RETURN @;3 
CALL INVALIDSTYPE; 
RETURN @;3 
END ARITHMETICSTYPE; 


DELETESASFILE: PROG; 
Pee( CTR := GETSTYPE) = 3 THEN 
DO; 
CALL CODESBYTE(DLR); 
CALL STDSATTRIBUTES (1); 
END; 
ELSE IF CTR = 2 THEN 
Os 
CALL CODESRYTE(DLS);3 
CALL STDSATTRIBUTES(@); 
END} 
ELSE CALL PRINTSFRROR( “IT’);3 
END DELETESASFILE;} 


REWRITESASRECORD: PROC; 
IF GETSLEVEL <> 1 THEN CALL PRINTSERROR(’WL’); 
ELSE 
or 
CURSSYM = GETSFCBSADDR; 
fopmec in c= GCETPSTYPE) = 3° THEN 
DO; 
CALL CODESBYTE(RWR); 
CALL STDSATTRIEBUTES(1);3 
END; 
ELSE IF CTR = 2 THEN 
DO; 
CALL CODESBYTE(RWS); 
CALL STDSATTRIBUTES (2); 
END; 
ELSE CALL PRINTSERROR( IT’); 
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END; 
END REWRITESASRECORD; 


ATTRIBUTES: PROC; 
CALL CODESADDRESS(LSADDR);3 
CALL CODESBYTE(LSLENGTH) ; 
CALL CODESBYTE(LSDEC); 

END ATTRIBUTES; 


LOADSLSID: PROC (SSPTR)3 
Des SSPTR BYTE; 
IP ((ASCTR := VALUE(SSPTR)) <= NONSNUMERICSLIT) OR 
(ASCTR = NUMERICSLITERAL) THEN 
DO; 
LSADDR = VALUE2(SPTR);3 
LSLENGTH = CONSLENGTE; 
ESP YEH = ASGIR; 
IF ASCTR = NUMERICSLITERAL THEN 
LSDEC = LSDECSTEMP; 
PisteLsorpee = 0; 
RETURN; 
END; 
TP ASCTR <= LITSZERO THEN 
DO; 
LSTYPE,LSADDR = ASCTR; 
Lopeeo— 0; 
onvGwe= 1; 
RETURN; 
END; 
CURSSYM = VALUE(SSPTR); 
LSTYPE = GETSTYPE; 
LSLENCTE = GETSLENGTE; 
fopeC = GETSDECIMAL: 
IF(LSADDR := VALUE2(S$PTR)) = @ THEN 
LSADDR = GETSADDRESS; 
END LOADSLSID; 


LOADSREG: PROC(REGSNO,PTR)} 
DCL (REGSNO,PTR) BYTE; 
CALL LOADSLSID(PTR); 
CALL CODESBYTE(LOD+ARITHMETICSTYPE)} 
CanL ATTRIBUTES; 
CALL CODESBYTE(REGSNO); 
END LOADSREG}3 


STORESREG: PROC(PTR); 
Det PTR BYTE; 
CALL LOADSLSID(PTR); 
CALL CODESBYTE(STO + ARITHMETICSTYPE - 1); 
Oo ATTRIBUTES; 
END STORESREG; 





STORESCONSTANT: PROC ADDRESS; 
IF(MAXSINTSMEM := MAXSINTSMEM - VARC(@)) < NEXTSAVAILAELE 
TEEN CALL FATALSERROR( “MO” )3 
CALL BYTESOUT(INT)3 
CALL ADDRSOUT(MAXSINTSMEM) 3 
CALL ADDRSOUT(CONSLENGTH := VARC(®)); 
DO CTR = 1 TO CONSLENGTH; 
F, CMEL BYTESOUT( VARC( CTR) ) 3 
END; 
RETURN MAXSINTSMEM; 
END STORFSCONSTANT; 


NUMERICSLIT: PROC BYTE; 
DCL CHAR BYTE; 
LSDECSTEMP = @; 


morcrR = 1 TO VAPC(G); 
IF NOT( DIGIT(CHAR := VARC(CTR)) 
OR (CHAR = =) OR ecemne = +) 


GORUCGHAR = ~. )) THEN RETURN FALSE; 
IF CEAR = °.” TEEN 
LSDFCSTEMP=VARC(@)-CTR; 
END; 
RETURN TRUE} 
FND NUMERICSLIT; 


ALPHASLIT: PROC BYTE; 
DO CTR = 1 TO VARC(Q); 
IF NOT(LETTER(VARC(CTR))) THEN RETURN FALSF; 
END; 
RETURN TRUE} 
END ALPEASLIT} 


ROUNDSSTORE: PROC} 
IF VALUE(SP) <> @ THEN 
DO; 
CALL CODESBYTE(RND)3 
CALL CODESEYTE(LSDEC); 
END; 
CALL STORFSREG(SP —- 1); 
END ROUNDSSTORE; 


ADDSSUB: PROC(INDEX)3 
Won INDEX BYTE; 
CALL LOADSREG(1,SP - 1); 
CALL CODESBYTE(ADD + INDEX); 
CALL ROUNDSSTORE} 

END ADDSSUB; 


MULTSDIV: PROC( INDEX); 
DCL INDEX BYTE; 
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CALL LOADSREG(@,MPP1); 
CALL LOATSREG(1,SP - 1)3 
GALL CODESBYTE(MUL + INDEX); 
CALL ROUNDSSTORE; 

END MULTSDIV; 


CHECKSSUBSCRIPT: PROC; 
DCL (TEMP,TEMPSADDR) ADDRESS; 
CURSSYM = VALUE(MP);3 
IF GETSTYPE < MULTSOCCURS THEN 
DO} 
CALL PRINTSERROR(“°IS’)3 
RETURN; 
END; 
IF NUMERICSLIT TEEN 
DO; 
TEMPSADDR = GETSALIDRESS} 
IF (TEMP s= GETSPREVSOCCURS) <> @ THEN 
CURSSYM = TEMP; 
CALL SETSVALUE2 
(TEMPSADDR + (GETSLENGTEH * (CONVERTSINTEG?R - 1)))3 
RETURN; 
END; 
CALL ONFSADDRSOPP(SCR,GETSADDRESS); 
IF (TEMP s= GETSPREVSOCCURS) <> @ THEN 
CURSSYM = TEMP; 
CALL CODESADDRESS(GETSLENGTS); 
CURSSYM = MATCH; 
IF ((CTR s= GETSTYPE) < NUMERIC) OR (CTR > COMP) THEN 
CALL PRINTSERROR( °TE”); 
CALL CODESADDRESS (GETSADDRESS) } 
CALL CODESBYTE(GETSLENGTH); 
CALL CODESBYTE(SUBSCNT)3 
CALL SETSVALUE2(SUBSIND); 
END CHECKSSUBSCRIPT; 


LOADSLABEL: PROC} 
CURSSYM = VALUE(MP); 
IF (ASCTR s= GETSADDRESS) <> @ TEEN 
CALL BACKSSTUFF(ASCTR,VALUE2(MP) ); 
CALL SETSADDRESS(VALUE2(MP)); 
IF GETSTYPE <> UNRESOLVED THEN 
CALL PRINTSERROR( “DD’); 
Obl SETSTYPE(LARELSTYPE)} 
IF (ASCTR := GETSFCBSADDR) <> @ THEN 
CALL BACKSSTUFF(ASCTR,NEXTSAVAILABLE); 
SYMBOLSADDR(FCBSADDR) = NEXTSAVAILABLE; 
CALL ONESADDRSOPP(RET,@);3 
END LOADSLABFL; 


LOADSSECSLAREL: PROC} 
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ASCTR = VALUE(MP); 
CALL SETSVALUE(FOLDSSECTION); 
HOLDSSECTION = ASCTR;} 
ASCTR = VALUE2(MP); 
CALL SETSVALUE2(EROLDSSECSADDR) 3 
HOLDSSECSADDR = ASCTR; 
CALL LOADSLABEL;} 
END LOADSSECSLABEL; 


LABELSADDRSOFFSET: PROC (ADDR, HOLD, OFFSET) ADDRESS; 
DCL ADDR ADDRESS; 
DCL (HOLD, OFFSET, CTR) BYTE; 
CURSSYM = ADDR; 
IF(CTR := GETSTYPE) = LABELSTYPE THEN 
DO; 
IF HOLD THEN RETURN GETSADDRESS; 
RETURN GETSFCBSADDR; 
END; 
IF CTR <> UNRESOLVED THEN CALL INVALIDSTYPE; 
IF HOLD THEN 
DO; 
ASCTR = GETSADDRESS;$ 
CALL SETSADDRESS(NEXTSAVAILABLE + OFFSET); 
RETURN ASCTR; 
END; 
ASCTR = GETSFCESADDR; 
SYMBOLSADDR(FCBSADDR) = NEXTSAVAILABLE + OFFSET; 
RETURN ASCTR; 
END LABELSADDRSOFFSET; 


LABELSADDR: PROC (ADDR, HOLD) ADDRESS; 
DCL ADDR ADDRESS, 
HOLDeE TE: 
RETURN LABELSADDRSOFFSET (ADDR, HOLD, 1); 
END LABELSADDR;} 


CODESFORSDISPLAY: PROC (POINT); 
Mae POINT BYTE; 
GATL LOADSLSID(POINT); 
CALL ONESADDRSOPP(DIS,LSADDR); 
CALL CODESBYTE(LSLENGTH); 
IF DISPLAYSFLAG THEN CALL CODESBYTE(1);3 
ELSE CALL COLESRYTE(Q); 
DISPLAYSFLAG = FALSE} 
END CODESFORSDISPLAY; 


ASANSTYPE: PROC BYTE; 


RETURN (LSTYPE >= ALPHA) AND (LS$TYP® <= LITSQUOTE); 
END ASANSTYPE;$ 


NOTSINTEGER: PROC BYTE; 


’ 
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RETURN LSDEC <> @; 
END NOTSINTEGER; 


NUMERICSTYPE: PROC BYTE; 
RETURN ((LSTYPE >= NUMERICSLITERAL) AND (LSTYPE <= COMP) ) 
OR (LSTYPF=LITSZERO) } 
END NUMERICSTYPE; 


GENSCOMPARE: PROC; 
DCL (HSTYPE,HSDEC) BYTE, (HSADDR,ASLENGTH) ADDRESS; 
CALL LOADSLSID(MP); 
LSTYPE = ANDSOUTSOCCURS(LSTYPE);3 
IF CONDSTYPE = 3 THEN /* COMPARE FOR NUMERIC */ 
DO; 
IF LSTYPE = ALPHA OR (LSTYPE > COMP) THEN 
CALL INVALIDSTYPE; 
CALL SETSVALUR2(NEXTSAVAILABLE); 
IF LSTYPF = NUMERIC THEN CALL CODESBYTE(CNU);3 
ELSE CALL CODESBYTE(CNS)3 
CALL CODESADDRESS(LSADIR); 
CALL CODESADDRESS(LSLENGTS); 
CALL SETSBRANCH; 
BRIE 
ELSE IF CONDSTYPE = 4 THEN 
DO; 


IF NUMERICSTYPE THEN CALL INVALIDSTYPRE;3 
CALL SETSVALUE2(NEXTSAVAILABLE); 
CALL CODES3YTE(CAL); 
CALL COLESADDRESS(LSADDR);3 
CALL CODESADDRESS(LSLENGTH);3 
CALL SETSBRANCH; 
END$ 
ELSE DO; 
IF NUMERICSTYPE THEN CTR=1;3 
EESs CTR = @ 
ESTYPE = LSTYPE; 
HSDEC = LSDEC;3 
HSADDR = LSADDR;} 
HSLENGTH = LSLENGTH; 
GALL LOADSLSIDYSP); 
IF NUMSRICSTYPE THEN CTR = CTR + 13 
IF CTR = 2 THEN /* NUMERIC COMPARE ¥*/ 
BO; 
CALL LOADSREG(G,MP); 
CALL SETSVALUR2(NEXTSAVAILABLE - 6); 
CALL LOADSREG(1,SP);3 
CALL CODESBYTE(SUB)3 
CALL CODESBYTE(RGT + CONDSTYPE); 
CALL SETSBRANCH; 
END} 
Eioe DO: 
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/* ALPHA NUMERIC COMPARE */ 
IF (HSTYPE = COMP) OR (LSTYPF = COMP) THEN 
CALL INVALIDSTYPE; 
FLSE IF (HSLENGTE <> LSLENGTH) THEN 
IF NOT ((LSTYPE >= LITSSPACE) ANT 
(L$TYPE <= LIT$ZERO)) XOR 
(Cher yPeE >= LITSSPACE) *AND 
(ESTYPE <= LITSZERO)) THEN 
CALL INVALIDSTYPE; 
ELSE IF (LSDEC <> @) OR (HSDEC <> @) THEN 
IF NOT ((LSTYPE = NUMSED) XOR 
(ESTYPE = NUMSED)) THEN 

CALL INVALIDSTYPE; 

CALL SETSVALUE2(NEXTSAVAILABLE) 5 

CALL CODESBYTE(SGT+CONDSTYPE); 

CALL CODEFSADDRESS(HSADDR); 

CALL CODESADDRESS(LSADDR); 

CALL CODESADDRESS(HSLENGTE); 

CALL SETSBRANCY; 

END} 
END; 
END GENSCOMPARE; 


MOVESTYPF: PROC BYTE; 


DCL 

HOLDSTYPE BYTE, 
ALPFASNUMSMOVE Pele Ca. 
ASNSEDSMOVE fel ts 
NUMFRICSMOVE Petes. 
NSEDSMOVE ir os 


LSTYPE = ANDSOUTSOCCURS(LSTYPE); 
IF((HOLDSTYPE := ANDSOUTSOCCURS(GETSTYPE)) = GROUP) OR 
isl iPS = GROUP) 
THEN RETURN ALPHASNUMSMOVE; 
IF HOLDSTYPE = ALPHA THEN 
IF ASANSTYPE OR (LSTYPE = ASED) OR (LSTYPE = ASNSED) 
OR ((ALPHASLITSFLAG) AND 
(LSTYPE = NONSNUMERICSLIT)) 
THEN RETURN ALPHASNUMSMOVE; 
IF HOLDSTYPE=ALPBASNUM THEN 


DO; 
IF NOTSINTEGER AND (LSTYPE <> NUMSED) TEEN 
CALL INVALIDSTYPE; 
RETURN ALPHASNUMSMOVE; 
END; 
IF (HOLDSTYPE >= NUMERIC) AND (HOLDSTYPE <= COMP) TEEN 
DO; 
IF (LSTYPE = ALPHA) OR (LSTYPE > COMP) THEN 
Grilal hiya I. DSY PE $ 
RETURN NUMFRICSMOVS; 
END; 
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IF HOLDSTYPE = ASNSED THEN 


DO; 
IF NOTSINTEGER AND (LSTYPE <> NUMSED) THEN 
CALL INVALIDSTYPE; 
RETURN ASNSEDSMOVE; 
END; 


IF FOLDSTYPE = ASED THEN 
IF ASANSTYPE OR (LSTYPE > COMP) OR 
(L$STYPE = NONSNUMERICSLIT) 
THEN RETURN ASNSEDSMOVE; 
IF HOLDSTYPE = NUMSED THEN 
IF NUMERICSTYPE OR (LSTYP™ = ALPEASNUM) THEN 
RETURN NSEDSMOVE; 
CALL INVALIDSTYPE; 
RETURN Q;3 
END MOVESTYPE; 


GENSMOVE:PROC; 
DCL (ADDR1,EXTRA,LENGTH1) ADDRESS; 


ADDSADDSLEN: PROC; 
CALL CODESADIRESS(ADDR1); 
CALL CODESADDRESS(LSADDR) ; 
CALL CODESADDRESS(LSLENGT)3 
END ADDSADDSLEN; 


CODESTORSEDIT: PROC; 
CALL ADDSADDSLEN; 
CALL CODESADDRESS (GETSFCESADDR) ; 
CALL CODESADDRESS(LENGTH1) ; 

END CODESFORSEDIT; 


CALL LOADSLSID(MPP1); 
CURSSYM=VALUE(SP); 
IF (ADDR1 := VALUE2(SP)) = @ THEN ADDR1 = GETSADDRESS; 
LENGTH1 = GETSLENGTH; 
DO CASE MOVESTYPE; 
/* ALPHA NUMERIC MOVE */ 


DO; 
IF LENGTH1 > LSLENGTH THEN 
EXTRA = LENGTH1 -— LSLENGTH; 
ELSE [0; 
EXTRA = @;3 
LSLENGTH = LENGTR1; 
END; 
CALL CODESBYTE(MOV) ; 
CALL ADDSADDSLEN; 
CALL CODESADDRESS (EXTRA); 
END; 
/* ALPHA NUMERIC EDITED */ 
DO; 
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CALL CODESBYTE(MED) $ 
CALL CODESFORSEDIT; 

END; 

/* NUMERIC MOVE */ 

DO; 
CALL LOADSREG(2,MPP1); 
CALL STORESREG(SP); 

END; 

/* NUMERIC EDITED MOVE */ 

DO; 
CALL CODESBYTE(MNE)} 
CALL CODESFORSEDIT; 
CALL CODESBYTE(LSDEC); 
CALL CODESBYTE(GETSDECIMAL); 

END; 

END; 
END GENSMOVE;$ 


CODESGEN: PROC(PRODUCTION); 
DCL PRODUCTION BYTE; 
IF PRINTSPROD THEN 
DO; 
GAD CRIN 3 
CALL PRINTCHAR( POUND); 
CALL PRINTSNUMBER( PRODUCTION); 
END; 
DO CASE PRODUCTION; 
hm PRODUCTION S */ 
; /* CASE @ NOT USED */ 
/* a <P=DIV> ::= PROCEDURE DIVISION <USING> . 7 
y* 1 <PROC-BODY> a, 
Ol; 
COMPILING = FALSE; 
IF SECTIONSFLAG THEN CALL LOADSSECSLABEL; 
END; 
/* 2 <USING> ::= USING <ID-STRING> oy, 
IF VALUE(MP - 1) = @ THEN 
mo 1 = @ TO IDSPTR; 
CURSYM = IDSSTACK(I);3 
CALL SETSADDRESS(13 + I1);3 


9 


ELSE 
DO; 
CALL CODESBYTE( PAR); 
CALL CODESADDRESS(IDSPTR + 1); 
NON fe=90 TO IDSPTR; 
CURSSYM = IDSSTACK(I); 
CALL CODESADDRESS(GETSADDRESS ); 
END; 
END; 
yo 5 \!l <EMPTY> x / 
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/* 
/* 


/* 
/* 
/* 
/* 


; /* NO ACTION REQUIRED */ 
4, <ID—-STRING> s::= <ID> 
IDSSTACK(IDSPTR := @) = VALUE(SP); 


5 \! <ID-STRING> <ID> 
DO} 
IF(IDSPTR := IDPTR + 1) = 20 TEEN 
DO; 
CALL PRINTSERROR( “ID’)3 
IDSPTR=19; 
END; 
IDSSTACK(IDSPTR)=VALUE(SP)3 
END} 
6 <PROC-BODY> ::= <PARAGRAPE> 
: e NO ACTION REQUIRED x / 
\! <PROC-BODY> <PARAGRAPH> 
; ia NO ACTION REQUIRED */ 
8 <PARAGRAPH> ::= <IDD . 
; /* NO ACTION RECUIRED */ 
9 \f <ID> . <SENTENCE-LISTD 
DQ} 
IF SECTIONSPLAG = @ THEN SECTIONSFLAG = 23 
CALL LOADSLAREL;} 
END; 
12 Silipos Cl LC Nae 
DO; 
IF SECTIONSFLAG<>1 THEN 
0; 
IF SECTIONSFLAG = 2 THEN 
CALL PRINTSERROR( °PF’);3 
SECTIONSFLAG = 13 
ROLDSSECTION = VALUE(MP)3;3 
HOLDSSECSADDR = VALUE2(MP); 
END; 
ELSE CALL LOADSSECSLABEL; 
END3 
11 <SENTENCE-LIST> ::= <SENTENCED . 
CALL CHKSNXTSSENTENCE} 
12 \l <SENTENCE-LIST> 
12 <SENTENCED . 
CALL CHKSNXTSSENTENCE;} 
13 <SENTENCE> ::= <IMPERATIVE> 
; /* NO ACTION REQUIRED */ 
14 \! <CONDITIONAL> 
; /* NO ACTION REQUIRED */ 


15 \! ENTER <ID> <OPT-ID> 
CALL PRINTSERROR( “NI” ); 

16 <IMPERATIVED ::= ACCEPT <SUBID> 
DO} 

CALL LOADSLSID(SP); 

CALL ONESADDRSOPP(ACC,LSADDR)}3 

CALL CODESBYTE(LSLENGTH); 


Zot 


a7 
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ay 
yf 
a7 
7 / 


a 


#/ 
#/ 


a, 
a7, 
ey, 






j* 
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/* 


/* 
/* 


/* 
/* 


/* 


/* 
/* 


/* 
/* 


/* 


ae Neer iTEMETICD 
; Pe NOVACIION REQUIRED */ 
18 NTPCALL <CALL-LIT> <USING> 


CURSYM = VALUE(MPP1)3 
CALL CODESBYTE(SBR); 
YO) 3h Sat He) (25 
IF I <= GETSPSLENGTH THEN 
CALL BYTESOUT(SYMBOL(STARTSNAME + 1I));3 
FLSE CALL BYTESOUT(224)3 
END} 
CALL INCSCOUNT(6)3 
END; 
19 \! CLOSE <CLOSE-LST> 
DO; 
PE TYPE BYTH; 
IF ((TYPE := GETSTYPE) > @) AND (TYPE < 5) THEN 
GALL ONESADDRSOPP(CLS ,GE TSFCBSADDR); 
ELSE CALL PRINTSERROR( “CE” )3 
END; 
19 \! <FILE-ACT> 
: /* NO ACTION REQUIRED */ 
21 \! DISPLAY <DISPLAY-LST> 
: /* NO ACTION REQUIRED */ 
22 \! DISPLAY <DISPLAY-LST> WITE 
22 NO ADVANCING 
; /* NO ACTION REQUIRED-NOT IMPLEMENTED */ 
23 \! EXIT <PROGRAM-ID> 
Auk CODESEYTE (EXT); 
24 NG 0s <ED> 
CALL ONESADDRSOPP(BRN,LABELSADDR(VALUE(SP),1))3 
25 \! GO <ID-STRING> DEPENDING 
25 <ID> 
DO; 
CALL CODESBYTE(GDP); 
CALL CODESBYTE(IDSPTR + 1)3 
CURSSYM = VALUE(SP); 
CALL CHKSUDSVAR(SP)3 
CALL CODESBYTE(GETSLENGTE);3 
CALL CODESADDRESS(GETSADDRESS )} 
DO CTR = @ TO IDSPTR; 
CALL CODESADDRESS 
(LABELSADDRSOFFSET(IDSSTACK(CTR),1,2) )3 
END; 
END; 
26 MiEMOvVMeCE LIZ iI D>. TO <SUBID> 
CALL GENSMOVE; 
27 \! OPEN <ACT-LST 
; /* NO ACTION REQUIRED */ 


ay 
ans 


a 


I 


ay, 
oo, 


ne 
a 


ay 
x / 


7A 


sf / 


28 \! PERFORM <ID> <TERUD <FINISH>*/ 
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/* 


/* 
/* 


/* 


/* 
[* 


BIG 

DCL (ADDR2,ADDR3) ADDRESS; 
IF VALUE(SP - 1) = @ THEN 

ADDR2 = LABELSADDRSOFTSET(VALUE(MPP1) 
ELSE ADDR2 = LAPFLSADDRSOFFSET(VALUE(SP-1 
IF (ADDRZ := VALUE2(SP)) = @ THEN 

ADDPS = NEXTSAVAILABLE + 73 
ELSE CALL BACKSTUFF(VALUE(SP) ,NEXTSAVAILAPLE + 7); 
CALL ONESADDRSOPP( PER, LAEBELSADDR(VALUE(MPP1) ,1)):?3 
CALL CODESADDRESS(ADDR2)3 
CALL CODFSADDRESS(ADDRS) 3 


et 


END; 
29 \! STOP <TERMINATED a7, 
DO} 
IF VALUE(SP) = @ THEN CALL CODESBYTE(STP); 
moe IF (VALUE(SP) < LITSSPACE) OR 
(VALUE(SP) > LITSZFRO) THEN 
DO} 
CALL ONESADDRSOPP(STD,VALUE2(SP));3 
CALL CODESBYTE(CONSLENGTS)3 
END} 
ELSE 
DO; 
CALL ONESADDRSOPP(STLD ,VALUE(SP));3 
Cube CGODESBY Te(1); 
END; 
END} 
3Q <GLOSt=LS> as] <S1D> ae / 
; /* NO ACTION REQUIRED */ 
oul NU =CCLOSE-LSTD <ID> x / 
; /* NO ACTION REQUIRED-NOT IMPLEMENTED */ 
32 Gewepkt-bol> ::= <LIT/ID> sf 
CALL CODESFORSDISPLAY(SP)3 
, oo WieecDis PMMY—-LST> <LIT/ID> a3) 
DO; 
DISPLAYSFLAG = TRUE; 
e CALL CODESFORSDISPLAY(S?); 
9 
Z4 <ACT-LST> ::= <TYPE-ACTIOND <OPEN-LST> x / 
DO; 
De TYPE BYTE; 
iape = GETSTYPE; 
If (TYPE = 1 OR TYP? = 4) AND (VALUR(MP) <> 2) THEN 
CALL ONESADDRSOPP(OPN + VALUER(MP),GETSTCRSADDR); 
ELSE 
Meee — 2 OR TYPR = 3) THEN 
CALL ONFSADDRSOPP(OPN + VALUE(MP) ,GETSFCRSADPDR)}3 
i ELSE CALL PRINTSERROR( “OR” ); 
35 \! <ACT-LST> <TYPE-ACTION> ay, 
BE <OPEN-LST> ey 





/* 
/* 
/* 


/* 


/* 
/* 


/* 
/* 
/* 


/* 


/* 


/* 
/* 


/* 
/* 


/* 
[7 


/* 
/* 


5 fk 
oG 
/* 
ery, 
/* 
oe 


ze 


~~» @ 


CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
END; 
og 
CALL KEE 
40 
40 
CALL KEE 
a} 
; (ig 
42 
CALL KEE 
43 
CALL KEE 
44 
; Le 
45 
DO; 
CALL 
CALL 
END; 
46é 
DO; 
CALL 
CALL 
CALL 
CALL 
END; 
47 
47 
CALL BAC 
48 
48 
CALL BAC 
49 
49 
CALL BAC 
58 


508 


NO ACTICN REQUIRED-NOT IMPLEMENTED */ 


<OPEN-LST> :3:= <ID>D a7 
NO ACTION REQUIRED */ 
\! <OPEN-LST> <ID> 7 
NO ACTION REQUISED-NOT IMPLEMENTED */ 
<FINISHD :s:= <L/ID> TIMES i, 


LOADSLSID(MP) 5 
ONESADDRSOPP(LDI,LSADDR); 
CODESBYTE(LSLENGTH ); 

SETS VALUF2(NEXTSAVAILABLE) } 
CNESADDRSOPP(LEC,@); 
SETSVALUR(NEXTSAVAILABL®); 
CODESADDRESS(@); 


\l <STOPCONDITION>D a 
PSVALUES; 
\l <VARYINGD <CITERATIOND af, 
<STOPCONDITION>D * / 
PSVALUES; 
\!l <EMPTY>D * / 
NO ACTION R®QUIRED */ 
<STOPCONDITIOND ::= UNTIL <KCONDITION>D ao /, 
PSVALUES; 
<VARYING>D ::= VARYING <SUBID> 7, 
PSVALUES; 
<ITERATIOND s:= <FROMD <BYD * / 
NO ACTION REQUIRED */ : 
<FROM> ::= FROM <L/IDD oy 
LOADSREG(2,SP)3 


STORESREG(MP - 1); 
<BY> ::= BY <L/ID> a 
LOADSREG(@,MP - 2); 


LOADSREG(1,SP)3 
CODESRYTE(ADD); 
STORESREG(MP - 2)3 
<CONDITIONAL> ::= <ARITHMETICD <SIZE-ERRCR> */ 
<IMPERATIVE> * / 
KSCOND; 
\! <FILE-ACT> <INVALID> ef 
<IMPERATIVE> * / 
KSCOND; 
\! <READ-ID> <SPECIAL> iad | 
<IMPERATIVED * / 
KSCOND; 
\! <IF-NONTERMINALD * / 


<CONDITIOND <IF<LST> <ELSED*/ 
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y* 


/* 
/* 
/* 
/* 


/* 


/* 
/* 


/* 
/* 


/* 
/* 


j* 
/* 


/* 
/* 


/* 
/* 


/* 
/* 


/* 
/* 


/* 
/* 


5g <IF-LST> END-IF 7, 
DO} 

CALL BACKSTUFF(VALUE(MPP1) ,VALUE2(SP - 3)); 

CALL BACKSTUFF(VALUE(SP -— 3),NEXTSAVAILABL®); 
END; 


51 \! <IF-NONTERMINAL> x / 

51 <CONDITIOND 7, 

51 <IF-LST> END-IF % / 
CALL BACKSTUFF(VALUE(MPP1) ,NEXTSAVAILAPLE)3 

52 <IF-LST> ::= <STMT-LSTD = 
; /* NO ACTION REQUIRED */ 

53 \! NEXT SENTENCE xe / 
DO; 

CALL ONESADDRSOPP (BRN ,NEXTSADDRESS); 

NEXTSADDRESS = NEXTSAVAILABLE - 2; 
END} 
, 54 <ELSED ::= ELSE 7 
03 

VALUR(SP - 1) = NEXTSAVAILABLE + 13 

CALL ONESADDRSOPP(BRN,@)3 

VALUE2(SP —- 1) = NEXTSAVAILABLE} 
END; 

55 <ARITHMETICD ::= ADD <ADD-LST> TO <SUBID> * / 

55 <ROUND> * / 
CALL ADDSSUB(@)3 

56 \! ADD <ADD-LST> GIVING <SUBID>*/ 

56 <ROUND> % / 
DO; 

IF VALUE(MP) = @ THEN CALL PRINTSERROR(“IG’);3 

CALL ROUNDSSTORE; 
END; 

57 NDI bech, LDP iNnTO <SUBSID> */ 

577 <ROUNDD 7 


CALL MULTSDIV(1)3 
5a MID IVIDE <L/1P> BY <SURID> * / 
58 GIVING <SURID> <ROUND> * / 
CALL PRINTSERROR( ‘NI’ ); 
59 Wott IDeeaty, IP>eINTO <SUBID> */ 


; GIVING <SUBIID <ROUND> * 

CALL PRINTSERROR( “NI’); 
62 Wiatihobpie <L/1D> BY <SUBID> */ 
<ROUND> * / 


62 
CALL MULTSDIV(Q); 
61 Nerul tr iiecn, ID> BY <SURID> */ 


61 ee GIVING <SUBID> <ROUND> * / 

CALL PRINTSERROR( “NI” )3 
62 \! SUBTRACT <SUB-LST> FROM ay 
<SUBID> <ROUNI> x / 


G2 
CALL ADDSSUB(1); 
63 Ne Suen eet COUB=LST> GIVING a 
63 <SUBID> <ROUNDD ef, 
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/* 
/* 
/* 


/* 
/* 


DOs 


IF VALUE(MP) 
CALL ROUNDSSTORE; 


END; 
64 


@ THEN CALL PRINTSERROR( “1G” );3 


\! COMPUTE <SUBID> = <ARITH-EXP>*/ 


GALT. PRINTSERROR( NI’); 


1S 


DO; 


<ADD-LST> 
CALL LOADSREG(O,SP); 
66 


= <1 /1D> 
\! <ADD-LST> <L/ID> 


CALL LOADSREG(1,SP)3 
CALL CODESBYTE(ADD);3 
CALL CODESBYTE(STI)3 
VALUE(MP - 1) = 13 


END; 
Sy 


<SUB=LS1>°: 


s= <L/ID> 


CALL LOADSREG(2,SP);5 


68 
DO; 


Nimo Upon. <b/ 1 D> 


CALL LOADSREG(1,SP);3 
CALL CODESBYTE(ADD);3 
CALL CODESBYTE(STI); 
VALUR(MP - 1) = 13 


END; 
69 


™~ ON NP SN. GU. 
3 % # % + % 


we 
™ 
3 


~ 
% 


eo. 
82 


<ARITH-EXP> ::= <TERMD 


NO ACTION 
NO ACTION 
NO ACTION 
NO ACTION 
NO ACTION 

<TERM> : 
NO ACTION 
NO ACTION 


NO ACTION 


<PRIMARY> 


NO ACTION 
NO ACTION 


REQUIRED-NOT IMPLEMENTED */ 
| \! <ARITH-EXP> + <TERM> 

REQUIRED-NOT IMPLEMENTED */ 
\! <ARITH-EXP> - <TERMD 

REQUIRED-NOT IMPLEMENTED */ 


\l + <TERM> 
REQUIRED-NOT IMPLEMENTED */ 
\l - <TERM> 


REQUIRED-NOT IMPLEMENTED */ 


:= <PRIMARY> 


REQUIRED-NOT IMPLEMENTED */ 
NI <TRRM> * <PRIMARY> 
REQUIRED-NOT IMPLEMENTED */ 
\! <TERM> / <PRIMARY> 
REQUIRED-NOT IMPLEMENTED */ 
¢:= <PRIM-FLEM> 
REQUIRED-NOT IMPLEMENTED */ 


\!l <PRIMARY> ** <PRIM-ELEM> 


REQUIRED-NOT IMPLEMENTED */ 


<PRIM-ELEM> 33= <L/ID> 


NO ACTION 
NQ ACTION 


REQUIRED-NOT IMPLEMENTED */ 
\! ( <ARITH=-RFXP>D ) 
REQUIRED-NOT IMPLEMENTED */ 


<FILE-ACT> ::= DELETE <ID> 
CALL DELETESASFILE; 


\! REWRITE <ID> 


Zoe 


ive 
ae 


7 


x / 
x / 
yh 


7 


x / 





CALL REWRITESASRECORD; 


/* 


/* 
/* 
/* 
/* 
/* 


/* 
/* 
/* 
/* 
/* 
/* 
/* 
/* 
/* 


83 Mime ClLb> <SPECITAL—ACT> 7 
CALL WRITESASRECORD; 

84 <UononT LION> ss =—<SETERMD r7 
; /J* NO ACTION REQUIRED */ 

85 \! <CONDITIOND OR <BITERMD a 
; /* NO ACTION RECUIRED-NOT IMPLEMENTED */ 

86 <BTERM> ::= <BPRIMD A / 
’ /* NO ACTION REQUIRED */ 

87 \! <BTERM> AND <BPIRM> i 
i /* NO ACTION REQUIRED-NOT IMPLEMETED */ 

88 <EPRIM> 3::= <LIT/ID>  / 
; /* NO ACTION REQUIRED */ 

89 \IV<LIT/IB>D <NOT> <COND-TYPE> ao / 
DO; 

IF IFSFLAG TEEN 

DO; 
IFSFLAG = NOT IFSFLAG; /* RESET IFSFLAG */ 
CALL CODESBYTE(NEG); 
END; 

CALL GENSCOMPARE; 

END; 


’ 


92 


Mt 


<BTERM> ) 


/* NO ACTION REQUIRED-NOT IMPLEMENTED */ 
<GOUD=TYPED 3: 
CONDSTYPE = 3; 


91 


92 


CONDSTYPE = 4; 
93 


CALL KEEPSVALUES; 
<NOT> 


94 


::= NOT 


IF NOT IFSFLAG THEN 
CALL CODESBYTE(NEG); 


ELSE IFSFLAG 


NOT IFSFLAG; 


= NUMERIC 
\! ALPHABETIC 
\! <COMPARED <LIT/ID> 


[= BSSET LPSELAG 
xe 


x / 
*/ 
*/ 
# / 
 / 


95 \! <EMPTY> / 
; /* NO ACTION REQUIRED */ 

96 <COMPARE> ::= GREATER ay 
CONDSTYPE = @;3 

97 \! LESS # / 
CONDSTYPE = 1; 

98 \! EQUAL 7 
CONDSTYPE = 23 

99 Nl yA 
CONDSTYPE = 2; 

122 Yin on /, 
CONDSTYPE = 13 

101 SoS oy 
CONDSTYPE = 2; 

122 <ROUNDD ::= ROUNDED ay 
CALL SETSVALUE(1);3 

123 \! <EMPTY> * / 
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/¥ 
/* 
/* 


/* 
{/* 
/* 
/* 
/* 
/* 


/* 


/* 


/* 


/* 
/* 


/* 
j* 
/* 


; /* NO ACTION REQUIRED */ 

104 <TERMINATED ::= <LITERALD 
; /* NO ACTION REQUIRED */ 

CD 


\! RUN 
;  /* NO ACTION REQUIRED - VALUE(SP) ALREADY ZERO */ 


126 <SPECIAL>D ::= <INVALIDD 
; /* NO ACTION REQUIRED */ 
187 \! END 
DO; 
CALL SETSVALUE(2); 
CALL CODESEYTE(EOR); 
CALL SETSBRANCH; 
END; 
108 <OPT-ID> ::= <SUBIDD 
’ /* VALUE AND VALUE2 ALREALY SET */ 
109 \I<EMPTY)D 
/* VALUE ALREADY ZERO */ 
112 <STMT-LST> ::= <CIMPERATIVE>D 
/* NO ACTION REQUIRED */ 
ia 1 \! <STMT-LST>D <CIMPERATIVE>D 
/*®* NO ACTION REQUIRED */ 
112 \l <CONDITIONALD 
/* NO ACTION REQUIRED */ 
iS \!l <STMT-LSTD> <CONDITIONALD 
; /* NO ACTION REQUIRED */ 
114 <TURUD ::= TERU <ID>D 
CALL KEEPSVALUES; 
115 WHECEVETY> 
; /* NO ACTION REQUIRED */ 
116 <INVALID> ::= INVALID 
DO; 


~~. © we wa. @ 


CALL SETSVALUR(1); 
CALL CODESBYTE(INV)3 
CALL SETSBRANCH} 


217 CSIZE-ERRORD s:= SIZE ERROR 


CALL CODESBYTE(SER)3 
CALL UNRESSBRANCH; 


me CSPECIAL-ACTD ::= <WHEND ADVANCING <HOW-MANY> 


CALL KEEPSVALUES; /* CARRACE CONTROL */ 
ilo NCE MPTY> 

’ /* NO ACTION REQUIRED */ 
122 <WHEND :3= EPEFORE 


WRITESBEFORE = TRUE; /* CARRAGE CONTROL */ 
eZ \! AFTER 
WRITESAFTER = TRUE; /* CARRAGE CONTROL */ 


122 <HOW-MANYD s:= <INTEGERD 
’ /* NO ACTION REQUIRED */ 
2 \! PAGE 
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/* 
/* 
/* 
/* 
i 
/* 
/* 


/* 


/* 
/* 
/* 
/* 
/* 
/* 


/* 


CALL SETSVALUE(19@1) 


125 

CALL SETSVALUE(1)3 
126 

CALL SETSVALUE(2); 
127 <SUBID> :: 


» 
9 


/* CARRAGE CONTROL */ 
124 CIVER=ACTIOND ¢s= INPUT 
: /* NO ACTION RECUIRED - VALUR(SP) ALREADY ZERO */ 


\! OUTPUT 
\!t I-0 
<SUBSCRIPT> 


; /* VALUE AND VALUE2 ALREADY SET */ 


128 
CALL CEKSUDSVAR(SP) 
129 <INTEGERD 


DO; 


x 


! <ID> 


s:= <INPUT>D 
CALL SETSVALUE(CONVERTSINTEGER)3 
132 <ID> ::= <INPUTD 


CALL SFTSVALUE(MATCEH); 
IF GETSTYPE = UNRESOLVED THEN 
CALL SETSVALUE2(NEXTSAVAILABLE)3 


END; 
DO; 


1351 <L/ID> ::= <INPUTD 


IF NUMERICSLIT THEN 


DO; 


CALL SETSVALUE(NUMERICSLITERAL);$ 
CALL SETSVALUE2(STORESCONSTANT)5 


END; 
ELSE 
DO; 


CALL SETSVALUE(MATCH)} 


END; 


152 Ne 
’ /* NO ACTION REQUIRED */ 


153 


A 


CALL CEXSUDSVAR(MP)3 


SOUEBSG RIE. > 
ZERO 


GALL SETSVALUE(LITSZERO); 


154 SSUBochiIeT> < 


CALL CHECKSSUBSCRIPT; 
HSS CSUBSCRIPT-LST> ::= <INPUT>D 
; 7* NO ACTION REQUIRED */ 


1356 


\! <SURSCRIPT-LST> 


CALL PRINTSERROR( “°NI’); 


Ws'7 <CALL-LIT> ; 


c= <LiT> 


CALL SETSVALUE(MATCH);3 
s= <LIT> 


ALPHASLIT; 


CALL SETSVALUE(NONSNUMERICSLIT); 
CALL SETSVALUE2(STORESCONSTANT) 5 


158 <NN-LITD : 
DO; 

ALPHASLITSFLAG 
END; 

1359 


\! SPACE 


265 


? 


s= <ID> ( <SUBSCRIPT-LSTD ) 


CINPUTD 


% / 


x / 
oY, 
a7, 
a, 
7 


aly 
yA 


ay 






GALL SETSVALUE(LITSSPACE)3 


ye 142 Ni OUOTE e / 
CALL SETSVALUE(LITSQUOTE); 

| 141 <LITERAL> ::= <NN-LITD a / 
’ /* NO ACTION REQUIRED */ 

/* 142 \l <INPUT>D ay 
DQ; 


IF NOT NUMERICSLIT THEN CALL INVALIDSTYPE; 
CALL SETSVALUE(NUMERICSLITERAL)} 
CALL SETSVALUE2(STORESCONSTANT) 5 


END; 

/* 145 \! ZERO x / 
CALL SETSVALUE(LITSZERO); 

/* 144 <LIT/ID> ::= <L/ID> oy 
; /* NO ACTION REQUIRED */ 

/* 145 \l <NN-=LIT> =H, 
; /* NO ACTION REQUIRED */ 

/* 146 <PROGRAM-IDTD> ::= <IDD ae / 
CALL CODESBYTE(EXT); 

/* 147 \! <EMPTY> = / 
; /* NO ACTION REQUIRED */ 

a 148 <RFAD-ID> ::= READ <ID>D aH 
CALL READSASFILE; 

/* 149 <IF-NONTERMINALD ::= IF % / 
TPSFLAG = TRUE} owe rao AG © / 


END; /* END OF CASE STATEMENT */ 
END CODESGEN; 


GETIN1: PROC ADDRESS; 
RETURN INDEX1(STATE); 
END GETIN1; 


GETIN2: PROC BYTE; 
RETURN INDEX2(STATE);3 
END GETIN2;3 


INCSP: PROC; 
VALUE(SP := SP + 1),VALUR2(SP) = 83 /* CLEAR THE STACK */ 
Meese >= PSTACKSIZE THEN CALL FATALSERROR( °SO”’); 

END INCSP;3 


LOOKAHEAD: PROC; 
IF NOLOOK THEN 
DO; 
CALL SCANNER; 
NOLOOK = FALSE; 
IF PRINTSTOKEN THEN 
DO; 
CADE MCRLI} 
CALL PRINTSNUMBER (TOKEN ); 
CALL PRINTSCHAR(’ °); 
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CALL PRINTSACCUM; 
END; 
END; 
END LOOKAHEAD; 


NOSCONFLICT: PROC (CSTATE) BYTE; 
hop (CSTATE,1,J,%) ADDRESS; 
He— INDEXA(CSTATE); 
K = J + INDEX2(CSTATE) - 1; 
mori = J TO K; 
IF READ1(I) = TOKEN THEN RETURN TRUE; 
END; 
RETURN FALSE; 
END NOSCONFLICT; 


RECOVER: PROC BYTE; 
DCL TSP BYTE, RSTATE ADDRESS; 
DO FOREVER; 
TSP = SP; 
DO WHILE TSP <> 255; 
IF NOSCONFLICT(RSTATE := STATESTACK(TSP)) TEEN 
DO; /* STATE WILL READ TOKEN */ 
IF SP <> TSP TEEN SP = TSP - 13 
RETURN RSTATE;3 


END; 
oe = for alk, 
END; 
CALL SCANNER; /* TRY ANOTHER TOKEN *¥/ 
END; 


END RECOVER; 
CUCU CUCU UPROGRAM EXECUTION STARTS HERE * * */ 


PeSUINITIALIZATION */ 
TOKEN = 8@; /* PRIME THE SCANNER WITH -PROCELURE- */ 
CALL MOVE(PASS1I$TOP — PASSISLEN, .DEBUGGING,PASS1SLEN }; 
BPoIlSEND = .LISTSBUFF + 127; 
Meter TR = .LISTSBUFF + LISTSPTR; 
OUTPUTSEND = .OUTPUTSBUFF + 127; 
MeerurSPTR = .OUTPUTSBUFF + OUTPUTSPTR; 
CALL PRINTSERROR(FALSE); /* INITIALIZE ERROR MSG CUTPUT */ 


/* *% * % * * * PARSER * 2% * x & #/ 


DO WHILE COMPILING; 
IF STATE <= MAXRNO THEN /* READ STATE */ 
DO; 
CALL INCSP;3 
STATESTACK(SP) = STATE; /* SAVE CURRENT STATE */ 
CALL LOOKAHRAD; 
ire TNT 
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J = I + GETIN2 - 13 
VOTO 
IF READ1(I) = TOKEN THEN 
DO; 
ee TOKEN = INPUTSSTR) OP 
(TOKEN = LITERAL) THEN 
DOK = 9 TO ACCUM(G); 
VARC(K) = ACCUM(Z); 
END; 
STATE = READ2(1);3 
NOLOOK = TRUE; 
io; 
END; 
ELSE IF I = J THEN 
roy 
CALL PRINTSERROR( “NP” ); 
CALL PRINT(.(’% ERROR NEAR $7));3 
CALL PRINTSACCUM; 
IF (STATE := RECOVER) = @ TEFN 
COMPILING = FALSE; 
END; /* END OF IF I = J */ 
END; /* END OF I =I T0 J */ 
END; /* END OF READ STATE */ 
ELSE IF STATE > MAXPNO THEN /* APPLY PRODUCTION STATE */ 
DO; 
MP = SP — GETIN23 
MPP1 = MP + 13 
CALL CODFSGEN(STATE — MAXPNO); 
SP = MP; 
eee CeeT Nl 
J = STATESTACK(SP)3 
DO WHILE (K := APPLY1(I)}) <> 32 AND J <> K3 
I=[+t1; 
END; 
ne er =NPeLy otf) je ==Ze TEEN COMPILING = FALSE; 
SPATE = K} 
END; 
ELSE IF STATE <= MAXLNO THEN /*LOOKAHEAD STATE*/ 
no; 
= sooner; 
CALL LOOKAHEAD; 
DO WHILE (X := LOOKi(I)) <> @ AND TOKEN <> K3 
io ol os 
END; 
STATE = LOOK2(I1); 
END; 
ELSE DO; /*PUSH STATES */ 
GALL INCSP: 
STATESTACK(SP) = GETING; 
STATE = GETINi; 
END} 
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END; /* OF WHILE COMPILING *¥/ 


CALL CODESBYTE(TER)5 
CALL ADDRSOUT(MAXSINTSMEM) ; 
IF NOT NOSCODE THEN 
mos 
CALL WRITESOUTPUT( .OUTPUTSBUFF, .OUTPUTSFCB) 
CAG CLOSe .OUTRUTSFCB)> 
END} 
CALL CHECKSUNRESOLVED; 
fot CRLF} 
CALL DCRLF} 
mol = @ TO 4; 
CALL PRINTSCEHAR(FRRORSCTR(I))3 
CALL WRITESTOSDISK (BRRORSCTR(1I));3 
END; 
CALL PRINT(.(”* PROGRAM ERROR(S)$’))3 
DO WHILE LISTSPTR < LISTSEND3 
CALL «BRIT ESTOSDISK(’ °); 
END3 
CALL WRITESTOSDISK(’ ”); 
Beit CLOSE(.LISTSFC3); 
GALL BOOT; 
END3 
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Bore UleR LISTING FOR WMODULE CINTERP NPS MICRO-COBOL 





§ TITLE( “NPS MIRCO-COBOL COMPILER INTERP’) PAGEWIDTE(8@) 
PAGELENGTH(6@) 
INTERP: DO; 
as COBOL COMPILER-INTERPRETER oe 
Vt NORMALLY LOCATED AT 1034 ef 


ag GLOBAL DECLARATIONS AND LITERALS 7 


DFCLARE DCL LITERALLY “DECLARE”, 
ia. EPPeRAGGY “LLlTERRLLY ~; 
DCL CR lee ad 
FALSE it Cok. 
FOREVER Lit “WHILE TRUE’, 
LF ai ata. - 
PROC lent “PROCEDURE”, 
SER Eee oates . /* CODE FOR SIZE ERROR */ 
TAB ert “O9E’, 
TRUE ELT “1 
ZONE fete “BOR’$ 


/* UTILITY VARIABLES */ 


DCT, ASCTR ADDRESS, . 
BASE ADDRESS, 
RBOOTER ADDRESS INITIAL (@@@QH) , 
BSADDR BASED BASE (1) ADDRESS, 
BSRYTE BASED BASE (1) FYTE, 
CALLSBASE ADDRESS, 
CALLSPTR BASED CALLSBASE (1) ADDRESS, 
CALLSTCP ADDRESS, 
CTR BYTE, 
CTRi BYTE, 
ERRORSCTR(5) BYTE EN ae ( Cm 
HOLD ADDRESS, 
ESADDR BASED HOLD (1) ADDRESS, 
HSRYTE BASED HOLD (1) BYTE, 
HISFREESMEM ADDRESS, 
LOWSFREESMEM ADDRESS, 
FISOFFSET ADDRESS INITIAL (@), 
LOWSOPFSET ADDRESS INITIAL (@), 
INDEX BYTE, 
RTNSBASE ADDRESS, 
RTNSPTR BASED RTNSBASF (1) ADDRESS, 


/* CODE POINTERS */ 
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CODESSTART ADDRESS INITIAL( 359808), 


PROGRAMSCOUNTER ADDRESS, 


CSADDR BASED PROGRAMSCOUNTER(1) ADDPESS, 
CSBYTE BASED PROGRAMSCOUNTER(1) EYTE, 
MAXSMEMORY ADDRESS INI TIAL(@310@8 ); 


ae ee GLOBAL INPUT AND OUTPUT ROUTINES * * * * %/ 


moh 
CURRENTSFCB ADDRESS, 
STARTSOFFSET LIT wos 


MONi: PROC (F,A) EXTERNAL; 
DCL F BYTE, A ADDRESS; 
END MON1; 


MON2: PROC (F,A) BYTE FXTERNAL; 
DCL ¥ BYTE, A ADDRESS; 
END MON2; 


PRINTSCHAR: PROC (CHAR); 
DCL CHAR BYTF; 
CALL MON1 (2,CHAR); 
END PRINTSCHAR; 


CRLF: PROC; 
CALL PRINTSCEAR(CR)$ 
CALL PRINTSCHAR(LF); 
END CRLF; 


PRINT: PROC (A)3 
DCL A ADDRFSS; 
POLL CRLF; 

CALL MON1(9,A)3 

END PRINT; 


READ: PROC(A) 3 
DCL A ADDRESS; 
CALL MON1(12,A);3 
END READ; 


PRINTSERROR: PROC (CODE); 

DCL CODE ADDRESS, I BYTF, TEN LIT °39H’3 

PAG CRLF} 

CALL PRINTSCEAR(HIGH(CODE));3 

CALL PRINTSCHAR(LOW(CODE));3 

im 4° 

DO WEILE (ERRORSCTR(I) := ERRORSCTR(I) + 1) = TFN; 
FRRORSCTR(I) = °@°3 
IF I > @ THEN 
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IF ERROPSCTR(I := I - 1) = % ”% THEN 
ERRORSCTR(I) = “O° "$3 
END; 
END PRINTSERROR3 


FATALSFRROR: PROC(CODE); 
DCL CODE ADDRESS; 
CALL PRINTSERROR(CODE); 
CALL MON1(9,.(° FATAL ERRORS”) ); 
CALL ROOTER; 
END FATALSERROR} 


SETSDMA: PROC; 
CALL MON1 (26, CURRENTSFCR + STARTSOFFSET ); 
END SETSDMA; 


OPEN: PROC (ADDR) BYTE; 
DCL ADDR ADDRESS, RET BYTE; 
CALL MON1 (26,8@H); 
RET = MON2(15,ADDR)3 
CALL SETSDMA; /* RESET BUFFER */ 
RETURN RET} 
END OPEN; 


CLOSE: PROC (ADDR); 
DCL ADDR ADDRESS; 
CALL MON1 (26,8@H)3 
IF MON2(16,ADDR) = 255 THEN CALL FATALSERROR( °CL’); 
CALL SETSDMA; /* RESET BUFFER */ 
END CLOSE} 


DELETE: PROC; 
CALL MON1(19,CURRENTSFCB)3 
END DELETE; 


MAKE: PROC (ADDR); 

DCL ADDR ADDRESS} 

IF MON2(22,ADDR) = 255 THEN CALL FATALSERROR( “ME” ); 
END MAKF; 


DISKSREAD: PROC BYTE; 
RETURN MON2(20,CURRENTSFCB)3 
END DISKSREAD; 
DISKSWRITE: PROC BYTR;3 
RETURN MON2(21,CURRENTSFCB); 
END DISKSWRITE; 
[RR HM MK KH HR HK KR KR OX UTILITY PROCEDURES * * * # © *% 4 8 % %/ 
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SUBSCRIPT (8) ADDRESS; 


RES: PROC(ADDR) ADDRESS; 
/* THIS PROC RESOLVES TEE ADDRESS OF A SUBSCRIPTED 
IDENTIFIFR OR A LITERAL CONSTANT */ 
DCL ADDR ADDRESS, 
PeeyY TR; 
IF ADDR > 32 THEN 
IF ADDR > HEISFREESMEFM THEN RETURN ADDR - HISOFFSET; 
ELSE RETURN ADDR + LOWSOFFSET; 
IF ADDR < 8 THEN RETURN SUBSCRIPT(ADDR); 
IF ADDR > 12 TEEN RETURN CALLSPTR(ADDR - 12); 
[TO CASE ADDR - 123 
RETURV .(% ”)3 
RETURN .(2748);3 
RETURN .(°O’)3 
END} 
RETURN Q;3 
END RES} 


MOVE: PROC(FROM,DESTINATION,COUNT); 
DCL (FROM,DESTINATION,COUNT) ADDRFSS, 
(F BASED FROM, D BASED DESTINATION) BYTE; 
DO WHILE (COUNT := COUNT - 1) <> @FFFFB; 
D = F3 
FROM = FROM + 13 
DESTINATION = DESTINATION + 13 
END; 
END MOVE} 


BELG: PROC(DESTINATION,COUNT,CEAR); 
CCL (DESTINATION,COUNT) ADDRESS, 
(CHAR,D EASED DESTINATION) BYTE; 
DO WHILE (COUNT := COUNT - 1) <> @FFFFH; 


b= CHAR; 
DESTINATION = DESTINATION + 1; 
END; 
END FILL; 


FILLER: PROC BYTE} 
IF CSADDR(1) = @BH THEN RETURN 274; 
FLSE IF CSADDR(1) = @CE THFN RETURN °27°3 
ELSE RETURN ” 73 

END FILLER} 


CONVERTSTOSHEX: PROC(POINTER,COUNT) ADDRESS; 
DCL POINTER ADDRESS, (COUNT,CEAR,CTR) EYTE; 
ASCTR = @3 
BASE = POINTER; 

DO CTR = @ TO COUNT - 13 
I¥ ((CHAR := BSBYTE(CTR)) = ’-%) OR 
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((CFAR -— ZONF >= °2”) AND 
(CREAR -— ZONE <= °9’%)) THEN RETURN ASCTR := @3 
IF CFAR = ’.° THEN RETURN ASCTR; 
IF CHAR <> °+° THEN 
ASCTR = SEL(ASCTR,S) + SEL(ASCTR.1) + 
(CHAR - °@”); 
END; 
RETURN ASCTR; 
END CONVERTSTOSEEX; 


eee MK CODE CONTROL PROCEDURES * * * * * 6 OM OH #/ 
DCL BRANCHSFLAG Piel INITIAL(FALSE)$ 


INCSPTR: PROC (COUNT); 

DCL COUNT BYTE; 

PROGRAMSCOUNTER = PROGRAMSCOUNTER + COUNT; 
END INCSPTR; 


GETSOPSCODE: PROC BYTE; 
CTR = CSBYTE(Q); 
CALL INCSPTR(1);5 
RETURN CTR; 

END GETSOPSCODE; 


CONDSBRANCH: PROC(COUNT)s; 
/* THIS PROC CONTROLS BRANCHING INSTRUCTIONS */ 
DCL COUNT BYTE; 
IF BRANCHSFLAG THEN 
DO; 
BRANCHSFLAG = FALSE; 
PROGRAMSCOUNTER = CSADDR‘{COUNT)s 
END; 
ELSE CALL INCSPTR(SEL(COUNT,1) + 2); 
END CONDSBRANCH; 


INCRSORSBRANCE: PROC(MARK)3 
DCL MARK BYTE; 
IF MARK THEN CALL INCSPTR(2)3 
ELSE PROGRAMSCOUNTER = CSADDR(Q); 
END INCRSORSBRANCH;3 


fe * HK KH KH OH KH KH KH KX K COMPARISONS * * % % KR OH OM HK OK HR K/ 


CHARSCOMPARE: PROC RYTE; 
DCL ASADDR ADDRESS; 
ASADDR = FILLER; 
IF CSADDR(1) > OOH AND CSADDR(1) < @DH THEN 
DO ASCTR = @ TO CSADDR(2) - 13 
IF BSBYTFE(ASCTR) > ASADDR THEN RETURN 1; 
IF BSBYTE(ASCTR) < ASADDR THEN RETURN @;3 
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END; 
ELSE 
DO ASCTR = @ TO CSALDDR(2) - 1; 


IF BSBYTE(ASCTR) > HSBYTE(ASCTR) THEN RETURN 13 
IF BSBYTE(ASCTR) < HSRYTE(ASCTR) THEN RETURN Q; 


END; 
RETURN 2; 
END CHARSCOMPARE; 


NUMERIC: PROC(CHAR) RYTS3 

DCL CHAR BYTF; 

RETURN (CHAR >= °3°) AND (CHAR <= °9’);3 
END NUMERIC; 


LETTER: PROC(CHAR) BYTE; 

DCL CHAR BYTF; 

RETURN (CHAR >= °A”) AND (CHAR <= °2Z7)3 
END LETTER; 


SIGN: PROC(CHAR) BYTE} 

DCL CHAR BYTE; 

RETURN (CHAR = “+’) OR (CHAR = ’-’)3 
END SIGN$ 


CHKSSSNUM: PROC(BASE) BYTE; 
DCL BASE ADDRESS, 
BSBYTE BASED BASE (1) BYTE, 
Gi LONGRE BYTE; 


DO I = 1 TO (LENGTH := CSADDR(2) - 1) - 13 
IF NOT NUMERIC(BSRBYTE(I)) THEN RETURN FALS®;$ 


END; 


IF NUMERIC(BSBYTF(@)) AND NUMFRIC(BSBYTE(LENCTE)) THEN 


RETURN FALSE} 
CALL MOVE(BASE,.R@,LENGTH + 1)3 
IF NUMERIC(BSBYTR(Q) - ZONF) AND 
NUMERIC (BSRYTF(LENGTR)) THEN 
R@(@) = R@(@) — ZONE; 
ELSE IF NUMERIC(BSBYTE(@)) AND 
NUMERIC (RSBYTE(LENGTH) -— ZONE) THEN 
R@(LENGTH) = RO(LENGTH) -— ZONE; 
ELSE RETURN FALS?®}3 
RETURN TRUE} 
END CEKSSSNUM3 


STRINGSCOMPARE: PROC(PIVOT); 
DCL PIVOT BYTE; 
HOLD = RES(CSADDR(1));3 


IF CHKSSSNUM(BASF s= RES(CSADDR(@))) THEN BASE 


ELSE IF CRESSSNUM(HOLD) THEN FOLD = .RQ; 
IF CHARSCOMPARE = PIVOT TEEN 
BRANCHSFLAG = NOT BRANCHSFLAG; 
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CALL CONDSBRANCH(3)s; 
END STRINGSCOMPARE; 


COMPSNUMSUNSIGNED: PROC; 
BASE = RES(CSALDDR(2))3 
MOMASCTR = @ TO CSETDR(1) - 13 
IF NOT NUMFRIC(BSBYTE(ASCTP)) THEN 
ASCTR = CSADDR(1) + 13 
END; 
IF ASCTR = CSADDR( 
CALL CONDSBRANCH(2 
END COMPSNUMSUNSIGNET$3 


" TEZN BRANCHSFLAG = NOT PRANCHSFLAC; 
y 


COMPSNUMSSIGN: PROC; 
DCL (CHAR,SIGNSFLAG) BYTE; 
SIGNSFLAG = FALS?R; 
BASE = RES(CSADDR(@));3 
DO ASCTR = @ TO CSADDR(1) —- 13 
IF NOT NUMERIC(CHAR := RSEYTE(ASCTR)) TREN 
IF (ASCTR = @) OR (ASCTR = CSADDPR(1) - 1) THEN 
IF (SIGN(CHAR) OR NUMFRIC(CHAR-ZON®)) AND 
NOT SIGNSFLAG THEN 
SIGNSFLAG = TRUE; 
ELSE ASCTR = CSADDR(1) + 13 
ELSE ASCTR = CSALDR(1) + 13 
FND3 
IF ASCTR = CSADDR(1) THEN BRANCHSFLAG = NOT BRANCHSFLAG; 
CALL CONDSBRANCH(2);3 
END COMPSNUMSSIGN; 


COMPSALPHA: PROC; 
BASE = RES(CSADDR(@));3 
DO ASCTR = @ TO CSADDR(1) - 13 
IF NOT LETTER(BSBYTE(ASCTR)) THEN 
ASCTR = CSADDR(1) + 13 
END; 
IF ASCTR = CSADDR(1) THEN BRANCHSFLAG = NOT BRANCHSFLAG; 
CALL CONDSBRANCE( 2); 
END COMPSALPHA; 


/* KM NK HK KK OK *NUMERIC OPERATIONS * * *% *% % M MH A He a A 


DCL OG oni ,he) (18) PoUe aes REGISTERS */ 
DECSPT¢ Dee 
DECSPT1 Be Et. 
DECSPT2 Pra, 


DECSPTA(2) BYTE Role Dao cl). 
MOVESFLAG BYTE INITIAL(PALSE), 
OVERFLOW BYTE, 

RS PTR BYTE, 

REGSLENGTH BYTE oN Aer ad Ouse 
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SIGN@(3) BYir, 


SWITCH BYTE, 
TEMP Barr, 
NEGITIVE ler soe 
POSITIVE sed mea, 


CHECKSFORSSIGN: PROC(CHAR) BYTE: 


DCL CHAR BYTE; 

I’ NUMFRIC(CHAR) THEN RFTURN POSITIVE; 

IF NUMERIC(CBRAR - ZONE) TREN RETURN NECITIVE; 
CALL PRINTSERROR( ’°SI”’)3 

RETUPN POSITIVE; 


END CHECKSFORSSIGN; 


STORESIMMEDIATE: PROC; 


me crtR = @ TO 9; 
R@(CTR) = R2(CTR); 

END; 

Bees PTO = DECSPT2; 

SIGN@(Z) = SIGNS(2); 


END STORESIMMEDIATES 


ONFESLEFT: PROC; 


hol CTR RYTE; 
IF SHL(BSBYTE(@),4) = @ OR MOVESFLAG THEN 
DO; 
[9 CTR = BO TO REGSLENGTH —- 23 
RSBYTH(CTR) = SHL(BSRYTE(CTR),4) OR 
SHR(BSBYTE(CTR + 1),4)3 
END; 
BSBYTE(REGSLENGTE - 1) = 
SHL(BSBYTE(REGSLENGTH - 1),4);3 
END} 
ELSE OVERFLOW = TRUE; 


END ONESLEFT; 


ONESRIGHT: PROC; 


DEL CTR BYTE; 
CTR = RECSLENGTE; 
DO INDEX = 1 TO REGSLENGTH - 135 
CTR = CTR — 1; 
BSBYTE(CTR) = SHR(BSBYTE(CTR),4; OR 
SHL(BSBYTE(CTR - 1),4)3 


END; 

BSBYTE(@) = SER(BSBYTE(@),4)3 

I¥ RSBYTE(@) = OOH TEEN 
BSBYTE(@) = 99B; 


END ONESRIGET; 


SHIFTSRIGHT: PROC(COUNT); 


DCL COUNT EYTE; 
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PO CTR = 1 TO COUNT; 
CALL ONESRIGHT; 
END; 
mvp SHIFTSRIGET; 


SHIFTSLETT: PRoc (COUNT); 
mel COUNT BYTE; 
OVERFLOW = FALSE; 

IF COUNT = @ THEN 
DO; 


CTR = QO; 
RETURN; 
END; 
DO CTR = @ TO COUNT — 13 
CALL ONESLSFT; 
IF OVERFLOW AND NOT MOVESFLAG THEN RETURN; 
END; 
END SHIFTSLEFT; 


ALLIGN: PROC} 
mies, (X,Y) PYTE; 
RIGHTSOP:PROC(ADDR); 
DCL ADDR ADDRESS; 
IF OVERFLOW THEN 
DO; 
BASE = ADDR; 
CibPeSOMemoRIGeT(Y <= X = CTR); 
OVERFLOW = FALSB#; 
END; 
END RIGHTSOP; 


Y = @; 
IF DECSPTO>DECSPT1 THEN 
DO; 
BASE = .Ri;s 
CALL SHIFTSLEFT(X := DFCS$PTZ — DECSPT1); 
PeCoP hie = PeCSPTItCTR ; 
CALL RIGHTSOP(.2@); 
DECSPTO@ = DECSPTS — Y3 


BASE = .R@;3 
CALL SHIFTSLFEFT(X := DECSPT1 -— DECS$PTS); 
DECSPTO = DECSPTS+CTR}; 
CALL RIGHTSOP(.R1);3 
DECSPT1 = DECSPT1 —- Y3 
END; 
END ALLIGN; 


ADDSTOSEND: PROC(CY); 
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emecOy,),J) BYTE; 

CTR = REGSLENGTEB — 1; 
DO J =1 TO REGSLENGTH; 
I = RSBYTE(CTR); 

I = DEC(I+CY); 
CY = CARRY AND 1; 
RSBYTE(CTR) = I; 
CER Cir =" "1; 
END; 
END ADDSTOSEND; 


ADDSR@: PROC(SECOND, DEST); 
Mere 4SSCOND, DEST) ADDRESS, (CY,A,3,1,J) BYTE; 


HOLD = SFCOND;3 
BASE = DEST; 
oy = G; 

CTR = REGSLENGTE - 13 
me J = 1 TO RECSLENCTH; 
A = RO(CTR); 

B = HSBYTE(CTR)} 
CPA OY) 5 
GY = CMARY; 


I = DEC(I + 3B); 
CY¥e=s0CY OR GARRY) AND 1; 
BSBYTE(CTR) = T3 
CR = ClR— 1; 
END; 
IF CY THEN CALL ADDSTOSEND(CY); 
END ADDSR2;3 : 


COMPLIMENT: PROC (NUME); 
en NUMB BYTE; 
SIGN@(NUMB) = SIGNZ(NUMB) XOR 15 /* COMPLIMENT SIGN */ 
DO CASE NUMB; 


FOLD = .R@; 
HOLD = .R1; 
EOLD = .R2; 


END; 
DO CTR = @ TO REGSLENGTER —- 13 
moprie (CTH) = 99H — HSBYTE(CTR); 
END; 
END COMPLIMENT; 


R2SZERO: PROC BYTE; 

men I BYTE; 

IF (SHL(R2(8),4) <> 2) OR (SER(R2(9),4) <> 9) 
THEN RETURN FALSE; 

mom DO I = 1 TO 8} 

IF R2(I) <> @ TEEN RETURN FALSE; 
END; 
RETURN TRUP} 
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FND R2SZFPO; 


LEADINGSZEROES: PROC(ADDR) BYTE; 
DCL COUNT BYTE, ADDR ADDRESS; 
PouNT = 2; 
FASE = ADDR; 
pO CTR = 9 TO 93 
IF (RSBYTE(CTR) AND @F2R) <> @ THEN RETURN COUNT; 
COUNT = COUNT + 1; 
IF (BSBYTE(CTR) AND @FE) <> @ THEN RETURN COUNT; 
COUNT = COUNT + 13 
END; 
RETURN COUNT; 
END LFADINGSZEROES 3 


CEECKSRESULT: PROC; 
IF SHR(R2(8),4) = 9 THEN CALL COMPLIMENT(2);3 
BASE = .R23 
CALL ADDSTOSEND(@5E);3 
IF (SHR(R2(0),4)<>0) AND (DFCSPT2 = @) THEN 
OVERFLOW = TRUE; 
ELSE 
IF (SHR(R2(@),4) <> @) THEN 
DO} 
CALL SHIFTSRIGHT(1); 
Peesepie = DECSPT2 — 1; 
END}; 
BSRYTE(9) = BSBYTE(Q) AND OFG@H; 
IF LEADINGSZEROES(.R2) > 19 THEN 
SIGN@(2) = POSITIVE; 
END CHECKSRESULT; 


CRECKSSIGN: PROC; 
SIGN2(2) = POSITIVE; 
IF SIGN@(@) AND SIGN@(1) THEN RETURN; 
IF (NOT SIGN@(G)) AND (NOT SIGN@(1)) THEN 
DO; : 
SIGN@(2) = NEGITIVE; 
RETURN; 
END; 
IF SIGN@(@) THEN CALL COMPLIMENT (1);3 
FLSE CALL COMPLIMENT(@);3 
END CHECKSSIGN; 


CEECKSNUMERIC: PROC; 


We | BYTE; 
BASE = .R@; 
moyl = 0 TO 27; 


IF NOT NUMERIC(SER(BSBYTF(I),4) OR °O”’) OF 
NOT NUMERIC((BSRYTE(I) AND O@FH) OR ’O’) 
CALL PRINTSERROR( “NE” )3 


TPEN 
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END; 
END CHECKSNUMERIC; 


CHFCKSDECIMAL: PROC; 
IF DECSPT2<>(CTR := CSBYTE(Z)) THEN 
DO; 
HOVSsrLAG = TRUE; 
BAGH = oR25 
[hee cCoelzee CTR THEN CALL 
SHIFTSRIGHT(DECSPT2 - CTR); 
ELSE CALL SHIFTSLEFT(CTR-DECSPT2); 
MOVESTLAG = FALS33 
END} 
IF LEADINGSZEROES(.R2) < 19 —- CSRYTE(2) TREN 
OVERFLOW = TRURB; 
END CHECKSDECIMAL; 


ADD: PROC; 
CALL CHECKSNUMERIC; 
OVERFLOW = FALSE; 
oat L ALLIGN3 
CALL CHECKSSIGN; 
DECSPT2 = DECSPTQ; 
Onl ADDRO(.R1,.R2);3 
CALL CHECKSRESULT; 
END ADD; 


ADDSSERIES: PROC (COUNT); 
eG (1 ,COUNT) BYTE; 
DO I = 1 TO COUNT; 
CADE ADPSRE(.R2,.R2); 
END; 
END ADDSSFRIES; 


SETSMULTSDIV: PROC; 
CALL CHECKSNUMFRIC; 
OVERFLOW = FALSE} 
REGSLENGTH = 183 
SIGN@(2) = (NOT (SIGNO(@) XOR SIGN@(1)}) AND @1BE;3 
OWLL FILL(.R2,18,9);3 
END SETSMULTSDIV; 


RISGREATFER: PROC BYTE; 
men J BYTE; 
DO CTR = 2 TO 9; 
IF RI(CTR)>(I := 99 -— R@(CTR)) TEEN RETURN TRUE; 
IF R1(CTR)<I THEN RETURN FALSE} 
END? 
RETURN TRU} 
END R1ISGREATER; 
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MULTIPLY: PROC(VALUE); 
DCL VALUE BYTE; 
IF VALUE<>@ TEEN CALL ADDSSERIES (VALUE); 
BASE = .R@; 
CALL ONESLEFT; 
mnp MULTIPLY; 


DIVIDF: PROC; 
mie(l. J. K, Xx) BYTE; 
IF LEADINGSZERORS(.2@) > 19 THEN 
DO} 
OVERFLOW = TRUE; 
RETURN; 
END; 
IF LEADINGSZEROES(.R1) > 19 TEEN 
DO; 
CABGMEILE.R2,1e,9); 
RETURN} 
END; 
CALL SETSMULTSDIV; 
FASE = .RQ;3 
CALL SEIFTSLEFT(17)3 
DECSPT@ = DECSPTS + CTR}; 
BASE = .R1;3 
CALL SHIFTSLEFFT(17)3 
DECSPT1 = DECSPT1L + CTR? 
OVERFLOW = FALSF;3 
IF DECSPT@ > 17 THEN 
IF DECSPT1 < (X := DFCSPT@ -— 17) THEN 
DO; 
OVERFLOW = TRUE; 
DECSPT2 = @} 


DecsPpT2 = DvcsPTi —- X; 
ELSE 
DECSPT2 = DECSPT1 + (17 -— DECSPTQ); 
CALL COMPLIMENT(@); 
foet = 1 TO 19; 
J = @3 
DO WHILF RISGREATER; 
CALL ADDSR@(.R1,.R1)3 
IF R1(@) = 99H THEN 
CALL COMPLIMENT (1)3 
Je + 1; 
END$ 
Kee= SOR( 1,1 ); 
IF I THEN R2( 
ELSE R2(K) = 
BASE = .R@; 
CALL ONESRIGH 


K) = R2(K) OR J; 
R2(K) OR SHL(J,4)3 
as 
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END; 

REGSLENCTH = 10; 

CALL CHECKSRESULT; 
END DIVIDE; 


LOADSASCHAR: PROC(CHAR); 
DCL CHAR BYTE; 
IF (SWITCH s= NOT SWITCH) TREN 
BSBYTE(RSPTR) = BSBYTE(RSPTR) OR SEL(CHAR - 30F.4); 
ELS? BS3YTE(RSPTR s= RSPTR-1) = CHAR — 208; 
END LOADSASCHAR; 


LOADSNUMRERS: PROC(ADDR,CNT); 
DCL ADDR ADDRESS, (I,CNT)BYTE; 
FOLD = RES(ADDR); 
mre = CNT; 
me INDEX = 1 TO CNT} 
GoR = CTR — 1} 
CALL LOADSASCHAR(ESBYTE(CTR) )3 
END} 
CALL INCSPTR(5)3 
END LOADSNUMBERS;3 


SFTSLOAD: PROC (SIGNSIN); 
DCL (CTR,SIGNSIN) BYTE; 
DO CASE (CTR := CSBYTE(4)); 


BASE = .R@; 
EAS! = ni; 
BASE = .R2; 


END} 
DECSPTA(CTR) = CSBYTE(3)3 
SIGNO(CTR) = SIGNSIN; 
CALL FILL (BASE,18,@); 
RSPTR = 93 
SWITCH = FALSE; 

END SETSLOAD; 


LOADSNUMERIC: PROC; 

CALL SETSLOALDT(1)3 

CALL LOADSNUMBERS (RES(CSADDR(@)) ,CSBYTE(2) )3 
END LOADSNUMERIC; 


LOADSNUMSLIT: PROC; 
MOEA LITSSIZE,FLAG) BYTE; 


CHARSSIGN: PROC; 
MerssSiZe = LITSSIZE - 1;3 
HOLD = HOLD + 13 

END CHARSSIGN; 


MmerssizZeE = CSBYTE(2); 






HOLD = RES(CSADDR(O)); 
IF HS3YTE(9) = “-”% THEN 
DO; 
CALL CHARSSIGN; 
CALL SETSLOAD(NEGITIVE)3 


END; 
ELSE 
DO; 
IF HSEYTE(@) = “+° THEN CALL CHARSSIGN3 
CALL SETSLOAD(POSITIVE); 
END; 
FLAG = 0; 


min = LITSSIZE; 

Oe INDEX = 1 TO LITSSIZE; 
che = CTR = 1; 
ascent Cra ) = (sete EN FPLAG=LITSSIZE -— (CTR + 1); 
ELSE CALL LOADSASCRAR(HSRYTE(CTR) ); 

END; 

DFCSPTA(CSBYTE(4)) = FLAG; 

CALL INCSPTR(5);3 

END LOADSNUMSLIT; 


STORESONE: PROC} 
IF(SWITCH := NOT SWITCH) THEN 
BSBYTE(@) = SHR(HSBYTE(@),4) OR °O7’; 
FLSF 
DO; 
HOLD = EOLD - 1;3 
-BSBYTE(@) = (HSBYTE(@) AND OFH) OR °O’;3 
END; 
BASE = BASE - 1; 
END STORFSONE; 


STORESASSCHAR: PROC(COUNT); 
DCL COUNT BYTE; 
SWITCH = FALSE; 
HOLD = .R2 + 93 
IF CSBYTE(4) <> SER OR NOT OVERFLOW THEN 
BO CTR = 1 TO COUNT; 
CALL STORESONE; 
END; 
END STORFSASSCHAR; 


SETSZONE: PROC (ADDR); 
DCL ADDR ADDRESS; 
IF NOT SIGN@(2) THEN 
DO; 
BASE = ADDR; 
IF CSBYTE(4) <> SER OR NOT OVERFLOW TEEN 
BSBYTE(3) = RSRYTE(Z) + ZONE; 
END; 
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CALL INCSPTR(4); 
END SETSZONE; 


SETSSIGNSSEP: PROC (ADDR); 
DCL ADDP ADDRESS} 
BASF = ADDR; 
IF CSPYTE(4) <> SER OR NOT OVERFLOW THEN 
IF SIGN@(2) TREN BSBYTE(@) = 
ELSE BSRYTE(G) = °-’3 
CALL INCSPTR(4);3 
END SETSSIGNSSEP} 


STORESNUMERIC: PROC; 
CALL CHECKSDECIMAL; 
BASE = RES(CSADDR(@)) + CSBYTE(2) - 1; 
CALL STORESASSCHAR(CSBYTE(2) )}3 

END STORESNUMERIC; 


MCVESNUMSEDITED: PROC; 


DCL CHAR RYTE, 
COUNT Bye. 
MLAS (2) BYTE, 
FLOATSVALUE RYTE, 
LASTSLOAD BYTE, 
LENGTH BYT?, 
MAXSLOADSPT BYTE, 
MINSLOADSPT BYTE, 
B51TSDEC BYTE, 
PSITSSIGN BYTE, 
SIGNSOUT heOHH 


FLOATSCHFC%: PROC( INDEX); 
DCL INDEX BYTE; 
IF FLAG(INDEX) THEN 
FLOATSVALUE = CHAR} 


ELSE 
DO; 
FLAG(INDEX) = TRUE; 
IF CTR <> MAXSLOADSPT OR INDFX = @ THEN 
MINSLOATSPT = CTR + 13 
IF INDEX = 1 TEEN 
PSITSSIGN = CTR; 
END; 


END FLOATSCHECK; 


FLOATSVALUE,MINSLOADSPT = 23 
mac (@),FLAG(1) = FALSE; 
MoersDEC = CSBYTF(11); 
PerrsSIGN = CSBYTE(&); 
MAXSLOADSPT = CSBYTE(&) — 13 
HOLD = RES(CSADDR(@))3 
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CALL MOVE(RES(CSADDR(Z)), FOLD, CSADDR (4) )3 
IF HSEYTE(MAXSLOADSPT) = “B’ OR 
ESBYTE(MAXSLOADSPT) = °R° THEN 
DO; 
MAXSLOADSPT = MAXSLOALSPT —- 23 
PSITSDFC = PSITSDEC - 23 
PSITSSIGN = PSITSSIGN - 23 
END3 
DO CTR = @ TO MAXSLOADSPT; 
CRAR = HSBYTE(CTR); 
IF CHAR = °9’ THEN 
BSEYRRCGER) = “Ol; 
FLSE IF CHAR = °$” THEN 
CALL FLOATSCHECK(@);3 
FLSE IF SIGN(CHAR) THEN 
CALL FLOATSCHECK(1)3 
ELSE IF CEAR = °2° THEN 
FLOATSVALUE = CHAR; 
ELSE IF CHAR = “B’ THEN 
ESBYTE(CTR) = a 
IF CTR > MAXSLOADS$PT - PSIT$DFC THEN 
IF CHAR = ve OR CuAR =~ OR 
CEU = “O° OR GEAR = °,° THEN 
PSITSDEC = PSITSDEC - 13 
END; /* DO CTR = @ TO MAXSLOADSPT */ 
IF PSITSSIGN = MAXSLOADSPT TEEN 


DO; 
MAXSLOADSPT = MAXSLOADSPT — 13 
PSITSDEC = PSITSDEC - 13 
END$3 
LENGTH = CSADDR(2)3 
BASE: = .R@3 


mept FILL(BASE,26, 2°); 
CALL MOVE(RES(CSADDR(1)),BASE,LENGTE) $3 
IF SIGN(BSBYTE(@)) THEN /* CHECK FOR LEADING SIGN */ 
DO; 
SIGNSOUT = BSBYTE(@);3 
BASE = BASE + 13 
LENGTH = LENGTH - 13 
END} 
ELSE IF SIGN(BSBYTE(CSBYTE(4) - 1)) THEN 
DO; 
SIGNSOUT = RBSBYTE(CSBYTE(4) - 1)3 
LENGTH = LENGTE - 1;3 
END; 
ELSE IF NOT CHECKSFORSSIGN (BSBYTE(CSBYTE(4) - 1)) TEEN 
DO; /* CHECK FOR TRAILING IMBEDDED SIGN */ 
SIGNSOUT = ’-’3 
BSBYTE(CSBYTE(4) - 1) = BSBYTE(CSRYTF(4) - 1) 
- ZONE} 
END; 
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ELSE IF NOT CHECKSFORSSIGN(BSBYTE(@)) THEN 
DO; /* CHECK FOR LEADING IMBEDDED SIGN */ 
SIGNSOUT = “-’; 
ESBYTE(@) = BSBYTE(2) -— ZONE; 
END; 
ELSE SIGNSOUT = “+73 
me PSITSDEC <> CSBYTE(1@) THEN 
DO; /* ALIGN DECIMAL POSITIONS */ 
IF PSITSDEC < CSBYTE(1@) TEEN 
LENGTH = LENGTH —- (CSBYTE(1%) - PSITSDEC); 
ELSE 
LENGTH = LENGTH + (PSITSDEC — CSBYTF(1@)); 
END; 
CTR = LENGTH - 1; 
COUNT, LASTSLOAD = MAXSLOADSPT; 
DO INDEX = 1 TO LENGTH; 
DO WHILE (HSBYTE( COUNT) “ ” OR HSBYTE(COUNT) 
OR HSBYTE( COUNT) °“/° OR HSBYTE(COUNT) 
OR HSBYTE(COUNT) _  yCEND 
(COUNT <= MAXSLOADSPT ); 
COUNT = COUNT — 13 


END} 
MMeESBYTE(CTR) <> °.° THEN 
DO; 
IF BSBYTE(CTR) <> °O’ THEN 
IF (COUNT < MINSLOADSPT) OR 
(COUNT = 255) THEN 
INDEX = LENGTH; 
ELSE 
DO; 
HSBYTE(COUNT) = BSRBYTE(CTR); 
LASTSLOAD = COUNT; 
END; 
COUNT = COUNT — 1; 
END} 
moe = CTR — 1; 
END} 
IF FLOATSVALUE <> @ THEN 
DO; 
orn oes 


DO WEILE HSBYTE(CTR) <> FLOATSVALUE;} 
CloR = Cine; 
END; 
DO WHILE (HSBYTE(CTR) Pee OR snore LE CTR ) ‘ 
OR HSBYTE(CTR) aOR Hoperr( CTR) 
OR HSBYTE(CTR) = FLOATSVALUE) 
AND (GER. <= ,MAXSLOADSPT) ; 
RSBYTE(CTR) = ; 
CTR = CTR + 1;3 
END; 
IF FLOATSVALUE <> °2° THEN 


ott 
| 
voN 


Ze", 






DO; 
HSBYTE(CTR := CTR -— 1) = FLOATSVALUE; 
IF SIGN(FLOATSVALUE) TEEN 
PSITSSIGN = CTR; 
END} 
END} 
DO CTR = @ TO LASTSLOAD3 
IF HSBYTE(CTPR) = “O° THEN 
ESBYTE(CTR) = °O’3 
FLSE 
IF HSBYTE(CTR) = °,” AND 
ESBYTE(CTR - 1) = °**% THEN 
Hoemineerth) = “*"$ 
END; 
DO CTR = LASTSLOAD + 1 TO MAXSLOADSPT; 
IF HSBYTE(CTR) = °*% OR HSBYTE(CTR) “$” OR 
SIGN(HSBYTE(CTR)) OR HSRYTE(CTR) Oreo THEN 
Mayne (Ork) = C3 


END; 
IF PSITSSIGN < CSBYTE(&) THE 
MESPYTECPSITSSIGN) = ~ 
HoByiRirpsl tSSIGN) = 
ELSE 
IF SIGNSOUT = °+’% THEN 
DO; 


N 
+” THEN 
SIGNSOUT; 


IF HSBYTE(PSITSSIGN) <> 
HSRYTE(PSITSSIGN + 
PSBYTE(PSITSSIGN) = ° ° 
END; 
CALL INCSPTR(12); 
END MOVESNUMSEDITED; 


iy) a7 © 
’ 


eo «= * = * * INPUT-OUTPUT ACTIONS * * * * * HR OK HR R/ 


DCL RBUFFSPTR ADDRESS, 
BUPFSBYTE BASED BUFFSPTR (1) BTS. 
BUFFSEND ADDRESS, 
RUFFSLENGTE ler "128", 
BUTFSTART ADDRESS, 
CHAR By ae 
CONSEUFF ADDRESS INITIAL (8@B), 
CONSBYTE BASED CONSBUFF BYTE, 
CONSINPUT ADDRESS INITIAL (828), 
CONTROLSFLAG BYTE PeCR Le (PALS) ; 
CURRENTSFLAG Bayne 
EOFSFLAGSOFFSET me ‘36°, 
EXTENTSOFFSET ee oi2 
FCRBSADDRSA BASED CURRENTSFCB (1) ADDRESS, 
FCBSBYTESA BASED CURRENTSFCR (1) RYTE, 
FLAGSOFFSET nee Cae 
HIGHSVALUE ever “OFFE’, 


Zee 






INVALID SYTE, 


PAG Lid 722°, /* CODE FOR PAGE */ 
PTRSOFFSET Ee CT a 

RECSNO GEE “Se, 

REWRITESFLAG RYTE INITIAL(@H), 

TTRMINATOR ae "TNE, 

TOPSOFSPAGE EIT OC”. 

VARSENT er SOR: 

WTF LET “48°; /* CODE FOR WRITE */ 


ACCEPT: PROC; 
CALL CRLF;3 
CALL PRINTSCHAR(2FH); 
CALL FILL(CONSINPUT,CSBYTE(2),”° “”); 
CONSRYTE = 1283 
CALL READ(CONSBUFF)} 
CALL MOVE (CONSINPUT,RES(CSADDR(Q)),CSBYTE(2))3 
GALL INCSPTR(3); 
FND ACCEPT; 


DISPLAY: PROC; 
DCL BSCNT BYTE; 
BASE = RES(CSADDR(@)); 
IF NOT CSBYTE(3) THEN CALL CRLF; 
BSCNT = CSBYTE(2)}3 
mo cTR = @ TO BSCNT —- 1;3 
CALL PRINTSCHAR(BSBYTE(CTR)); 
END; 
" CALL INCSPTR(4);3 
END DISPLAY; 


BEISFILESTYPE: PROC BYTE; 

BASE = CSADDR(@); 

RETURN BSBYTE(FLAGSOFFSET) ; 
END GETSFILESTYPE; 


BETOFILESTYPE: PROC(TYPE); 
DCL TYPE BYTE; 
BASE = CSADDR(@); 
IF GETSFILESTYPE <> @ THEN CALL FATALS$FRROR( ‘OF’ 
BSBYTE(FLAGSOFFSET) = TYPE; 
END SET$FILESTYPE; 


SETSISO: PROC; 
INVALID = FALSE; 
IF CSADDR(@) = CURRENTSFCB THEN RETURN; 


3 


/* STORE CURRENT POINTERS AND SET INTERNAL WPITF MARK */ 


BASE = CURRENTSFCB;} 
FCBSADDRSA(PTRSOFFSET) = BUFFSPTR;3 
FCBSBYTESA(FLAGSOFFSET) = CURRENTSPFLAG; 
/* LOAD NEW VALUES */ 


geo 






BUFFSEND = (BUFFSSTART := (CURRENTSFCB := CSADDR(@)) + 
STARTSOFFSET) + BUFFSLENGTE; 
CORRENTSFLAG = FCRSRYTESA(FLAGSOFFSET) 3 
FUFFSPTR = FCESALDRSA(PTRSOFFSST);3 
mp SETSISO; 


OPENSFILF: PROC(TYPE); 
mel TYPE BYTE; 
OMLL SETSFILESTYPE(TYP=); 
CURRENTSFCB = CSADDR(Q); 
FCESRYTESA(EXTENTSOFFSET) = @; 
CTR = OPEN(CURRENTSFCB)$ 
DO CASE TYPE — 1; 
/* INPUT */ 
DO} 
IF CTR = 255 THEN CALL FATALS®RROR( ‘NF’ ); 
END} 
/* OUTPUT */ 
DO; 
CALL DELETE; 
CALL MAXBE(CSADDR(@2))3 
END; 
; /* CASE 2 NOT USED */ 
yee 1-0 */ 
mo; 
Ir CTR = 255 THEN CALL FATALSERROR( ‘NEF’ ); 
END} 
END; /* DO CASE TYPE - 1 */ 
FCBSBYTESA(RECSNO) = @; /* SET TYE RECORD NUMEER IN FCB */ 
PCBSBYTESA( EOFSFLAGSOFFSET) = FALSE; /* SET THE EOF OFF */ 
BUFFSEND = (BUFFSSTART := (CURRENTSFCB + STARTSOFFSET)) + 
EUFFSLENGTS;} 
CURRENTSFLAG = FCBSBYTESA( FLAGSOFFSET);} 
BUPFSPTR,FCRSADDRSA(PTRSOFFSET) = BUFFSSTART - 13 
Ot INCSPTR(2);3 
END OPFNSFILS} 


WRITESMARK: PROC BYTE; 
RETURN ROL(CURRENTSFLAG,1); 
END WRITESMARK; 


SETSWRITESMARK: PROC; 
CURRENTSFLAG = CURRENTSFLAG OR &@8; 
END SETSWRITESMARK; 


WRITESRECORD: PROC; 
CALL SETSDMA;3 
CURRENTSFLAG = CURRENTSFLAG AND @FH3 
IF (CTR s= DISKSWRITE) = 2 THEN RETURN} 
CALL PRINTSFRROR( “WaA’); 
INVALID = TRUE; 
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END WRITESRECORD; 


READSRECORD: PROC; 
CALL SETSDMA3 
IF WRITESMARK THEN CALL WRITFRS®PECORD; 
IF (CTR := DISKSREALD) = @ TEEN RETURN; 
IF CTR = 1 THEN FCBSBYTESA(EOFSFLAGSOFFSET) = TRUE; 
INVALID = TRUE} 
END READSRECORD; 


RFADSBYTE: PROC BYTS;3 
IF (RUFFSPTR := RUFFSPTR + 1) >= PUFFEND TREN 
DO; 
CALL READSRECORD; 
IF FCBSBYTESA(EOFSFLAGSOFFSET) TEEN 
RETURN TERMINATOR; 
BUTFSPTR = BUFFSSTART} 
END; 
RETURN BUFFSEYTE(@); 
END READS3YTE; 


WRITESRBYTE: PROC (CHAR); 
DCL CHAR BYTES; 
IF (BUFFSPTR := RUFFSPTR+1) >= BUFFSEND THEN 
DO; 
CALL WRITESRECORD; 
BUFFSPTR = RBUFFSSTART; 
IF REWRITESFLAG THEN 
ne; 
CALL READSRECORD; 
FCESBYTESA(RECSNO) = FCBSBYTESA(RECSNO) — 13 
END; 
END} 
CALL SETSWRITESMARX3 
PoeeSBYTe(G) = CHAR; 
END WRITES BYTR; 


WRITESENDSMARK: PROC; 
GALL WRITESBYTE(CR); 
onl WRITESBYTE(LF); 

END WRITESENDSMARK; 


READSENDSMARK: PROC; 
IF (PEADSBYTEXDCR) OR (RFADSBYTE<SLF) TEEN 
CALL PRINTSFRROR( °EM’);3 
END READSENDSMAR<;$ 


RFADSVARIABLE:PROC;} 
Gait SETS1S03 
BASE = CSADDR(2)3 
Mon FILL(CSADDR(2),cSADDR(1),° °); 


2c 






DO ASCTR = @ TO CSADDR(1) —- 13 
IF (CTR := READSBYTE) = VARSEND THEN 
DO; 
CTR = READSBYTE; 
RETURN; 
END; 
IF CTR = TERMINATOR THEN 
DO; 
FCBSBYTESA(SOFSFLAGSOFFSET) = TRUE; 
RETURN; 
END; 
BSBYTE(ASCTR) = CTR; 
END; 
CALL READSENDSMARK; 
END READSVARIABLE; 


WRITESVARIABLE: PROC} 
DCL COUNT ADDRESS; 
CALL SFT$IS0; 
BASE = CSADDR(1)3 
COUNT = CSADDR(2);3 
DO WHILE ((BSBYTE(COUNT := COUNT - 1) =” %) 
AND (COUNT <> @));3 
END; 
DO ASCTR = 8 TO COUNT; 
CALL WRITESEYTE(BSBYTE(ASCTR)); 
END; 
CALL WRITES ENDSMARK3 
END WRITESVARIABLE} 


READSTOSMEMORY: PROC; 
DCL CHAR BYTE; 
BASE = CSADDR(1); 
DO ASCTR = @ TO CSADDR(2) - 13 
TP (CHAR := READSBYTE) = TERMINATOR THEN 


DO; 
INVALID, FCBSBYTESA(EOFSFLACGSOFFSET) = TRUE; 
RETURN; 
END; 
ELSE BSEYTE(ASCTR) = CHAR; 


END; 
CALL READSENDSMARK; 
END READSTOSMEMORY; 


WRITESFROMSMEMORY: PROC; 
BASE = RES(CSADDR(1));3 
DO ASCTR = @ TO CSADDR(2) - 13 
=. CALL WRITESBYTE(BSBYTE(ASCTR))3 
9 
IF CONTROLSFLAG TEEN 
CALL WRITESBYTE(CR); 


Zoe 






ELSE 
CALL WRITESENDSMARK; 
END WRITESFROMSMEMORY; 


/* * % % X RM XX RANDOM I-2 PROCEDURES * * * ¥ ¥ ¥ ¥ ¥/ 


SETSRANSPOINTER: PROC; 

/* THIS PROCEDURE READS THE RANDOM KEY AND COMPUTES 
WHICH RECORD NEEDS TO 8E AVAILABLE IN THE BUFFER 
THAT RECORD IS MADE AVAILABLE AND THE POINTERS 
SET FOR INPUT OR OUTPUT */ 

DCL (BYTESCOUNT,TEMP,RECORD) ADDRESS, 
EXTeNT BYTE; 
IF WRITESMARK THEN CALL WRITESRECORD; 
TEMP = CONVERTSTOSHEX(CSADDR(3) ,CSBYTE(&) )3 
IF TEMP = @ THEN 
DO 
INVALID = TRUE; 
RETURN; 
END} 
BYTESCOUNT = (CSADDR(2) + 2) * (TEMP -— 1)3 
RECORD = SHR(BYTESCOUNT,7)3 
EXTENT = SHR(RECORD,7)}3 
IF EXTENT <> FCBSBYTESA(EXTENTSOFFSET) THEN 
DO; 
CALL CLOSE(CSADDR(@))3 
FCBSBYTESA(FXTENTSOFFSET) = EXTENT; 
IF OPEN(CSADDR(@)) = 255 THEN 
DO}; 
IF SHR(CURRENTSFLAG,1) THEN 
CALL MAKE(CSADDR(@)); 
ELSE 
DO; 
INVALID = TRUE; 
FCBSEYTESA(EXTENTSOFFSET) = @3 
IF OPEN(CSADDR(@)) = 255 THEN 
CALL FATALSERROR( “OP” ); 
END; 
END; 
END; 
BUFFSPTR = (BYTESCOUNT AND 7FH) + BUFFSSTART —- 13 
FCBSBYTESA(32) = LOW(RECORD) AND 7FE; 
CALL READSRECORD;} 
END SETSRANSPOINTER; 


GETSRECSNUMBER: PROC ADDRESS} 
DCL (RECORD,LOGICALSRECSNUM,BYTESCOUNT) ADDRESS} 
RECORD = FCBSBYTESA(EXTENTSOFFSET ); 
RECORD = SHL(RECORD,7) + FCRSBYTESA (RECS$NO)3 
IF NOT SHR(CURRENTSFLAG,1) TEEN RECORD = RECORD - 1;3 
BYTESCOUNT = SEL(RECORD,7) + ((BUFFSPTR + 1)-BUFFSSTART)3 


y 
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LOGICALSRECSNUM = (BYTESCOUNT / (CSADDR(2) + 2)) + 13 
RETURN LOGICALSRECSNUM; 
END GETSRECSNUMBER; 


SETSRELATIVESKEY: PROC; 
DCL (RECSNUM, K) ADDRESS, 
(re cNT) BYTE, 
J(4) ADDRESS DATA (1000@,190¥,10¢,12), 
BUFF(5) BYTE; 
RECSNUM = GETSRECSNUMBER; 
mol = @ TO 3; 
or = 0; 
DO WHILE R®CSNUM D= (K := 
RECSNUM = RECSNUM - K; 
CNT = CNT + 13 
END; 
BUFF(I)=CNT + °O’$3 
END; 
BUFF(4) = RECSNUM + °°; 
PF (1 := CSBYTE(8&)) <= 5 THEN 
CALL MOVE(.BUFF + 5 - I,RES(CSADDR(3)),1);3 
ELSE 
DOs 


el) 3 


Q” 


CALL FILL(RES(CSADDR(Z)),I 


ez, B51) ys 
CALL MOVE(.BUFF,RES(CSADIR(32)) 


+ I - 5,5)3 
ND; 
END SETSRELATIVESKEY; 


WRTISEMPTYSREC: PROC; 
WOeASCTR = 1 TO CSADDR(2); 
CALL WRITESBYTE(HIGHSVALUS); 
END; 
CALL WRITESENDSMARK; 
END WRISEMPTYSREC; 


WRITESDUMMYSRECS: PROC(DIFFERENCE)} 
DCL DIFFERENCE ADDRESS, COUNT BYTE; 
poe COUNT = 1 TO DIFFERENCE; 
CALL WRISEMPTYSREC; 


END; 
END WRITESDUMMYSRECS; 


BACKSONESEXTENT: PROC; 
CALL CLOSE(CSALDDR(@)); 
IF (FCBSBYTESA(EXTENTSOFFSET) := 
FCBSBYTESA (EXTENTSOFFSET)-1)=255 TEEN 
CALL FATALSERROR( “W7");3 
I¥ OPEN(CSADDR(@)) = 255 THEN 
DO; 
CALL FATALSERROR( OP’); 
ENVALID = TRUE} 
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RETURN; 
END; 
FCBSBYTESA(RECSNO) = 127; 
END BACKSONES EXTENT; 


BACKSONESRECORD: PROC; 
IF(BUFFSPTR := BUFFSPTR - (CSADDR(2) + 2)) d= 
BUFFSSTART - 1 THEN 
DO; 
FCBSBYTESA(RECSNO) = FCBSBYTESA(RECSNO) - 13 
RETURN; 
END; 
BUFFSPTR = BUFFSSTART -— BUFFSPTR; 
DO WHILE BUFFSPTR > 1293 
BUFFSPTR = RUFFSPTR - 128; 
FCESBYTESA(RECSNO) = FCBSBYTESA(RECSNO) - 13 
END; 
BUFFSPTR = BUFFSEND -— BUFFSPTR; 
FCBSBYTESA(RECSNO) = FCBSBYTESA(RECSNO) - 2; 
IF FCBSBYTESA(RECSNO) > 127 THEN 
DO; 
CALL BACKSONESEXTENT; 
IF INVALID THEN RETURN; 
CALL READSRECORD; 
FCBSBYTESA(RECSNO) = 127; 
END; 


? 
CALL READSRECORD; 
FCBSBYTESA (RECSNO) 
END; 
END BACKSONESRECORD; 


FCESBYTESA(RECSNO) - 13 


REWRITESSEQ: PROC(FLAG); 
Den FLAG BYTE; 
CALL BACKSONESRECORD; 
REWRITESFLAG = TRUE; 
IF FLAG THEN CALL WRITESFROMSMEMORY;} 
ELSE CALL WRISEMPTYSREC; /* THIS IS A DELETE */ 
CALL WRITESRECORD; 
IF FCBSBYTESA(RECSNO) = @ THEN 
CALL BACKSONESEXTENT; 
ELSE 
FCBSBYTESA(RECSNO) = FCBSBYTESA(RECSNO) - 13 
REWRITESFLAG = FALSE; 
CALL READSRECORD; 
END REWRITESSEQ; 


CHECKSDIFFERENCE: PROC; 


DCL (DIFFERENCE,NEXTSRECORD,NEXTSKEY) ADDRESS; 
NEXTSRECORD = GETSRECSNUMBER; 
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NEXTSKEY = CONVERTSTOSHEX(CSADDR(3) ,CSBYTE(S) )3 

IF NEXTSRECORD > NEXTSKEY THEN CALL FATALSFRROR( ‘’W2’)3 

DIFFERENCE = NEXTSKEY - NEXTSRECORD; 

IF DIFFERENCE > @ THEN CALL WRITESDUMMYSRECS (DIFFERENCE); 
END CHECKSDIFFERENCE; 


/* MM OK OM OO OK OK OOK CR KE MOYURS 4 BR HR KR HH HR RK HK KK KS 


LOADSINC: PROC} 
HSBYTE(CTR) = BSBYTE(CTR1); 
Sori = CTR1 + 13 
mre = CTR + 1; 

END LOADSINC; 


CHECKSEDIT: PROC(CHAR); 
DCL CEAR BYTE; 
IF (CHAR = °2°) OR (CHAR = ’/’) THEN CTR = CTR + 13 
PESE IF CHAR = °R” THEN 
DO; 
MSOPYTE(GiR) =" = ~; 
CIR = Cine + 1; 
END} 
ELSF IF CHAR = ‘A’ TREN 
DO; 
IF NOT LETTFR(BSBYTE(CTR1)) TEEN 
CALL PRINTSERROR( “IC’);3 
CALL LOADSING; 
END} 
ELSE IF CHAR = ’9”% THEN 
DO; 
IF NOT NUMERIC (3SBYTE(CTR1)) THEN 
CALL PRINTSERROR( “IC” )3 
CALL LOALSINC; 
END} 
ELSE CALL LOADSINC; 
END CHECKSEDIT; 


/* eR MK RK OK Ke OK OK MACHINE ACTIONS * * KOK OK OO OME ORO 


STOP: PROC; 
meeL CRLF; 
weectR = 1 TO 4; 
es PRINTSCHAR(ERRORSCTR(CTR))}3 
5 
CALL MON1(9,.(° EXECUTION ERRORSS’));3 
CALL BOOTER; 
END STOP; 


f* *® KK KH MK RM KR KK MR KK OK KR KOK RK MR OK KK RK eK 


THE PROCEDURE BELOW CONTROLS THE EXECUTION OF THE COLE. 
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IT DECODES EACH OP-COLE AND PERFORMS TEE ACTIONS 


KR KK OK KK RO OR OK OK Ck FO OO OK OK OK OO OK Ko / 


EXECUTE: PROC; 


DO FOREVER; 
DO CASE GETSOPSCODE; 


Podi: ADD */ 
CALL ADD; 


J*® G2: 


Sue */ 


DO; 


END; 


moos MUL */ 


/* 
/* 
/* 
/* 
/* 


O43 


wo: 
G6: 


O77: 


G3; 


DIV 
NEG 
Ber 
Sat 
EXT 


<7 
ae 
ah 
sei 


= / 


DO; 


END; 


/* CASE ZERO NOT USED */ 


SIGN@(2) = SIGN@(2) XOR 1; 
CALL ADD; 


DG Cie Xk) UBYTS; 
CALL SETSMULTSDIV; 


BASE = .RO; 
CALL SHIFTSRIGHT(17); 
BASE = .R1; 


CALL SHIFTSRIGHT(1); 
DECSPT2 = DECSPTO + DFCS$PT1; 
I = 190; 
PO INDEX = 1 TO Q; 
CALL MULTIPLY(R1(I := 
CALL MULTIPLY(SHR(R1(1I 
END; 
BASE = .R2;5 
CALL SHIRISLERT(17 }; 
IF OVERFLOW THEN 
Pee Oke MOR n2 |  < 17 TEEN 
DECSPT2 = Q; 
ELSE 
DO; 


I - 1) AND @FB); 
),4))3 


DFCSPT2 = X - 17; 
OVERFLOW = FALSE; 
END; 
REGSLENGTH = 12; 
CALL CHECKSRESULT; 


CALL DIVIDE; 


BRANCHSFLAG = NOT BRANCHSFLAG; 


CALL STOP; 


CALL STORESIMMEDIATE; 


Zo, 





IF RTNSBASE < HISFREESMEM THEN 
DO» 


LOWSOFFSET = RTNSPTR(4 

HISOFFSET = RTNSPTR(2); 

RINSEASE = RINSBASE + 6; 

CALLSTOP = CALLSBASE; 

CALLSBASE = CALLSPTR(O); 
END; 


PROGRAMSCOUNTER a; (2); 
’ 


/* @9: RND */ 
DO; 
IF NOT OVERFLOW THEN 
De: 
BASE = .R23 
IF (DECSPT2 -— CSEYTE(G@)) > @ THEN 
nie: 
CALL SHIFTSRIGHT(DECS$PT2 - 
CSEYTE(@)); 

DECSPT2 =o ee); 


CALL SHIFTSLEFT(CSEYTE(2) - 
DECPT2); 
DECSPT2 = DECSPT2 + CTR; 
END; 
CWLL CHECKSRESULT; 
END; 
CALL INCSPTR(1);3 


mei: RET */ 


IF CSADDR(@) <> @ THEN 
DO; 
ASCTR = CSADDR(2Q); 
CSADDR(Q@) = 3 
PROGRAMSCOUNTER = ASCTR; 
END; 
ELSE CALL INCSPTR(2); 
RAD; 
me iis: CLS */ 
DO}; 
CALL SETSISO3 
IF WRITESMARK THEN 
DO; 
IF NOT SHR(CURRENTSFLAG,2) THEN 
CALL WRITFSBYTE(TERMINATO 
CALL WRITESRECORD; 
END; 
ELSE CALL SETSDMA;} 
CALL CLOSE(CSADDR(@));3 
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/* 


/* 
/* 


/* 
y 


/* 


/* 


/% 


/* 
/* 


/* 


fc: 


nO : 
14: 


ee): 


17: 


18: 


19: 


2a: 
Z.1: 


ec: 


SER 


BRN 
OPN 


Ort 
OFZ 


RGT 


RLT 


REQ 


INV 


EOR 


CURRENTSFLAG, FCBSBYTESA(FLAGSOFFSET) = @; 
CALL INCSPTR(2); 
END; 
ey 
IF OVERFLOW THEN 
DO; 
CARE UNG SPTR(S ); 
OVERFLOW = FALSE; 
END; 
Oy) 
PROGRAMSCOUNTER = CSADDR(Q)3 
* / 
DO; 
CALL OPENSFILE(1); 
CALL READSRECORD; 
END; 
/) 
CALL OPENSFILE(2); 
s/f 
DO; 
CALL OPENSFILE(4); 
CALL READSRECORD; 
END} 
% 
DO; 
IF NOT SIGN@(2) THEN 
BRANCHSFLAG = NOT BRANCESFLAG; 
CALL CONDSBRANCH(Q);3 
END; 
* / 
DO; 
IF SIGNO(2) AND NOT R2SZERO THEN 
BRANCHSFLAG = NOT BRANCHSFLAG; 
CALL CONDSBRANCH(Q)3 
END; 
% / 
DO; 
IF R2$ZERO THEN 
BRANCHSFLAG = NOT BRANCHSFLAG; 
CALL CONDSBRANCEH(@); 
END; 
* / 
CALL INCRSORSBRANCH( INVALID); 
0 
CALL 
INCRSORSBRANCH( FCBSBYTESA(EOPSFLAGSOFFSET) )3 


PAG * 


DO; 
DCL I BYTE; 
CALL SETSISO;3 
IF C$BYTE(2) < 10@ THEN 
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e 
’ 


HOwte= ot BO CSBYTE(2) 
Cae 


CALL WRITESBYTE 


CALL WRITESRYTE(TOPSOFSPAGE) } 
IF CSBYTE(3) = WTF THEN 
CONTROLSFLAG = TRUE; 
CALL INCSPTR(3)3 
END; 
/* 23: ACC */ 
CALL ACCEPT; 
/* 24: STD */ 
DO; 
TEMP = CSBYTE(S); 
CSEYTE(3) = @; 
CALL DISPLAY; 
CALL PRINT(.(LF, OPERATOR ENTER A <CRD> TO 
CONTINGES )); 
CALL PRINT(.(TAB,” OR ENTER AN 
TERMINATE.$%))3 


Seno 
CREAR = Q3 
DO WHILE (CHAR <> CR) AND (CHAR <> “S’); 
GALL OPRUNTCmGR, LF, ?$°)); 
CHAR = MON2(1,90); 
END; 
IF CHAR = CR THEN 
DO; 
PROGRAMSCOUNTER = PROGRAMSCOUNTER - 13 
CSBYTE(@) = TEMP; 
END} 
ELSON CALE, STOP; 
END; 
/* 25: LDI */ 
Des 
CSADIR(2) = 
CONVERTSTOSHEX(RES(CSADDR(@)),CSEYTE(2)) + 13 
GALL INCSPTR(S); 
END; 
/* 26: DIS */ 
Gkebe DISPLAY; 
/* 27:3 DEC */ 


DO; 
IF CSADDR(@) <> @ THEN 
CSADDR(@) = CSADDR(9) - 13 
IF CSADDR(@) = @ THEN 
PROGRAMSCOUNTER = CSADDR(1);3 
ELSE CALL INCSPTR(4)3 
END; 
/* 28: STO */ 
DO; 


CALL STORESNUMERIC; 
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/* 29:3 


me 30: 


ye 1: 


mo Oe: 


p53: 


ye 34: 


y~ 35: 
f* 36: 


CALL INCSPTR(4); 
} 


END 
STi */ 
DO; 
CALL STORESNUMERIC} 
CALL SETSZONE(RES(CSADDR(@)));3 
END; 
ST2 */ 
DOr; 
CALL STORESNUMERIC; 
CALL SETSZONE(RES(CSADDR(2)) + CSBYTE(2) - 1)3 
END; 
ST3 */ 
DO; 
CALL CHECKSDECIMAL; 
BASE = RES(CSADDR(@)) + CSBYTE(2) - 13 
CALL STORESASSCHAR(CSBYTF(2) - 1)3 
CALL SETSSIGNSSEP(RES(CSADDR(@)))3 
END; 
ST4 */ 
DO; 
CALL CHECKSDECIMAL; 
BASE = RES(CSADDR(2)) + CSBYTE(2) - 23 
CALL STORESASSCBRAR(CSBYTE(2) — 1); 
CALL SITSSIGNSSEP 
(RES(CSADDR(Q)) + CSBYTE(2) —- 1); 
END; 
S15 ~/ 
DO; 
CALL CHECK$SDECIMAL; 
IF SIGN@(2) = @ THEN 
R2(9) = R2(9) OR 21H; 
IF CSBYTE(4) <> SER OR NOT OVERFLOW TEEN 
DO; 
CTR = CSBYTE(2) / 2 + 13 
CALL MOVE 
(.R2 + 18 - CTR,RES(CSADDR(@)),CTR): 
END; 
CALL INCSPTR(4);3 
END; 
LOD */ 
CALL LOADSNUMSLIT; 
LDi */ 
CALL LOADSNUMERIC; 
LD2 */ 


Dos 
HOLD = RES(CADDR(@)); 
IF CHECKSFORSSIGN(HSBYTE(G)) THEN 
DO; 
GALL SETSLOAD(POSITIVE); 
CALL LOADSNUMBERS (CSADDR(@),CSBYTE(2)); 
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END} 
ELSE 
DO: 
TEMP = HSRBYTE(Q); 
CALL SETSLOAD(NEGITIVE) ; 
CALL LOADSNUMBERS 
(err DROg ae 1 CSBYTE(2) — 1); 
CALL LOADSASCHAR(TEMP - ZONE)} 
END; 
END; 
/* 37: LDS */ 
NO; 
DOier BYTES; 
HOLD = RES(CSADDR(@)); 
IF CHECKSFORSSIGN ( 
Cue = come Gte t= CsBrtr(2) — 1)) THEN 
DO; 
CARIN SETSLOAD(POSITIVE); 
foe =ele te); 
END} 
ELSE 
DO; 
CALL SETSLOAD(NEGITIVE); 
CALL LOADSASCHAR(CTR -— ZONE); 
END; 
CALL LOADSNUMBERS (CSADDR(2),1);3 
END; 
/* 38: LD4 */ 
DO; 
HOLD = RES(CSADDR(Q));$ 
IF (HSBYTE(Q@) = °+”) THEN 
CALL SETSLOAD(POSITIVE); 
ELSE CALL SETSLOAD(NEGITIVE); 
CALL LOADSNUMBERS(CSADDR(@) + 1, 
Copiein 2) — <1); 
END; 
/* 39: LDS */ 
DOs 
HOLD = RES(CSADDR(@))$ 
IF HSBYTE(CSBYTE(2) -— 1) = °+° THEN 
CALL SETSLOAD(POSITIVE); 
ELSE CALL SETSLOAD(NEGITIVE); 
CALL LOADSNUMBERS(CSADDR(@),CSBYTE(2) - 1)3 
END} 
/* 40: LD6 */ 
ner 
DOr eT CE; 
EOLD = RES(CSADDR(@)); 
[eh HSEY Teel 3= c$BYTE(2 7, 
CALL SETSLOAD(NEGITIVE) 
ELSE CALL SETSLOAD(POSITIVE 


2) THEN 
; 
); 
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/* 


/* 
/* 
/* 
/* 


/* 


/* 


41: 


42:3 


43: 
44: 


45: 


46: 


473 


48: 


PER 


CNU 
CNS 
CAL 


RWS 


DLS 


RDF 


WTF 


BASE = BASE +9 —- Is 
DO CTR = @ TO T; 
BSBYTE(CTR) = ESBYTE(CTR); 
END; 
BSBYTE(I) = BSBYTE(I) AND OFOH; 
CALL INCS$PTR(5); 
END; 


a 


De; 
BASE = CSADDR(1) + 13 
BSADDR(@) = CSADDR(2); 
PROGRAMSCOUNTER = CSADDR(QG); 
END; 


a7 


sf 


CALL COMPSNUMSUNSIGNED; 


CALL COMPSNUMSSIGN; 


“aud 


Uf 


aw 


/ 


CALL COMPSALPHA; 


DO; 
CALL SETSIS0O3 
IF NOT SHR(CURRENTSFLAG,2) THEN 
CALL FATALSERROR( °W6")3 
IF NOT FCBSBYTESA(EOFSFLAGSOFFSET) TEEN 
CALL REWRITESSEQ(1);3 
CALL INCSPTR(6)3 
END; 


ve. 
CALL SETSISO; 
IF NOT SHR(CURRENTSFLAG,2) THEN 
CALL FATALSERROR( ’W6"); 
IF NOT FCBSBYTESA(EOFSFLAGSOFFSST) TEEN 
CALL REWRITESS&Q(3); 
CALL INCSPTR(6)3 
END; 


DO; 
CALL SETS1S0; 
IF NOT CURRENTSFLAG THEN 
CALL FATALSERROR( ’w5’); 
IF NOT FCBSBYTESA(EOFSFLAGSOFFSET) THEN 
CALL READSTOSMEMORY; 
CALL INCSPTR(6); 
END; 


a 


DO; 
IF CSBYTE(6) = PAG TEEN 
CONTROLSFLAG = TRUE; 
CALL SETSISO; 
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/* 


/* 


/* 


/* 
/* 
/* 
/* 


fm 56: RRS */ 
D 


49: 


Bie: 


RVL 


WVL 


oc H 


Bic ° 


ao $ 


n 
to 


cn 
cy 


Stl 
SL. 
SEQ 
MOV 


IF NOT SHR(CURRENTSFLAG,1) THEN 
CALL FATALSERROR( ’W3’); 
CALL WRITESFROMSMEMORY; 
CALL INCSPTR(6); 
CONTROLSFLAG = FALSE; 
END} 
* / 
DO; 
CALL READSVARIAERLE; 
CALL INCSPTR(6);3 
END; 
x / 
DO; 
CALL WRITESVARIABLE; 
CALL INCSPTR(6); 
END} 
x / 
DO} 
SUBSCRIPT(CSBYTE(7)) = CSADDR(2) + CSADDR(1) 
(CONVERTSTOSEEX(CSADDR(2) ,CSEYTE(6)) - 1 
CALL INCSPTR(Q);3 
END; 
* / 
CALL STRINGSCOMPARE(1);3 
* / 
CALL STRINGSCOMPARE(@); 


— STRINGSCOMPARE(2); 
se 
BOs 
CALL MOVE(RES(CSADDR(1)),RES(CSADIR(2)), 
CSATIR(2))3 
IF CSADDR(3) <> @ TEEN 
DO; 
CALL FILL(RES(CSADDR(@)) + CSAITDR(2), 
CSADDR(3),FILLER); 
END; 
CALL INCSPTR(8);3 
END; 


Ol; 

DCL HSFLAG BYTE; 

HSFLAG = TRUE; 

GALL SETSISO; 

IF SHR(CURRENTSFLAG,1) THEN 
CALL FATALSERROR( ’W5’); 

DO WHILE (NOT FCBSEYTESA(EOFSFLAGS OFFSET) ) 
AND ESFLAG; 
HSFLAG = FALSE; 
CALL SETSRELATIVESKEY; 
CALL READSTOSMEMORY; 
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as 
e 
9 








IF BSBYTE(@) = HIGHSVALUE TEEN 
HSFLAG = TRUE} 
END; 
CALL INCSPTR(Q)3 
END} 
/* 57: WRS */ 
DO; 
CADE SPTISISO; 
IF NOT SHR(CURRENTSFLAG,1) THEN 
CALL FATALSERROR( “W17");3 
CALL CHECKSDIFFERENCE; 
CALL SETSRELATIVESKEY} 
CALL WRITESFROMSMEMORY; 
CALL INCSPTR(9)3 
END; 
/* 58: RRR */ 
DO; 
CALI SETSIS0; 
IF SER(CURRENTSFLAG,1) THEN 
CALL FATALSERROR( °w5’); 
CALL SETSRANSPOINTER; 
IF NOT INVALID THEN 
CALL READSTOSMEMORY 3 
IF INVALID THEN 
FCBSBYTESA(FOFSFLAGSOFFSET) = FALSF; 
CALL INCSPTR(Q); 
END; 
/* 59: WRR */ 


0; 
DCL DIFFERENCE ADDRESS; 
CALL SETSISO; 
IF SHR(CURRENTSFLAG,1) TEEN 
DO; 
CALL CHECKSDIFFERENCF; 
CALL SETSRELATIVESKEY; 
CALL WRITESFROMSMEMORY; 
END; 
BESS 
DO; 
IF SHR(CURRENTSFLAG,2) THEN 
DO; 
CALL SETSRANSPOINTER; 
IF NOT INVALID THEN 
IF (BUFFSEYTE(1)) = HIGESVALUE THEN 
DO; 
REWRITESFLAG = TRUE; 
FCBSEYTESA(RECSNO) = 
FCBSBYTESA(RECSNO) - 13 
CALL WRITESFROMSMEMORY 5 
REWRITESFLAG = FALSE} 
END; 
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ELSE CALL FATALSFRROR( ‘W4’ )3 
ELSE CALL FATALSERROR( “w3’)3 
END; 


END} 
CALL INCSPTR(9);3 
END; 
/* 60: RWR */ 
DO; 
CAGE SEISI 50; 
IF NOT SHR(CURRENTSFLAG,2) THEN 
CALL FATALSSRROR( ‘WE’ ); 
REWRITESFLAG = TRUE; 
CALL BACKSONESRECORD; 
IF NOT INVALID THEN CALL WRITESFROMSMEMORY3 
REWRITESFLAG = FALSE; 
CALL INCSPTR(Q)3 
END; 
/* 61: DLR */ 
DO; 
CALE SETS! SO; 
IF NOT SHR(CURRENTSFLAG,2) THEN 
CALL FATALSERROR( “W6’); 
CALL SETSRANSPOINTER; 
REWRITESFLAG = TRUE; 
IF NOT INVALID THEN 
DO; 
FCBSBYTESA(RECSNO) = 
FCBSBYTESA(RECSNO) — 13 
CALL WRISEMPTYSREC;} 
END; 
REWRITESFLAG = FALSE; 
GALL INCSPTR(9); 
END; 
P62: MED */ 
nen 


CALL MOVE(RES(CSADDR 
BASE = RES(CSADDR(1 
CERSCTRI = 6; 
DO WHILE (CTRi < CSADDR(2)) 

AND (CTR < CSADDR(4));3 

CALL CHECKSEDIT(HSBYTE(CTR) ); 
END; 
DO WHILE CTR < CSADDR(4);3 

IF HSBYTE(CTR) = °X’ OR 

HSBYTE(CTR) = “A” OR 


HOLD = RES(CSADDR(@)); 
eer ew hie) ys 


HSBYTE(CTR) “9° THEN 
HSBYTE(CTR) = FILLER; 
ELSE IF HSBYTE(CTR) = °B’ THEN 
ESpieccun = ~ "s 


CTR = CTR + 15 
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END; 
CALL INCSPTR(19); 
END; 
/* 63: MNE */ 
CALL MOVESNUMSEDITED; 
/* 64: SBR */ 
DO; 
RTINSBASE = RTNSBASE — 6; 
RINSPTR(Z) = PROGRAMSCOUNTER + 6; 
RTNSPTR(1) LOWSOFFSET; 
RINSPTR(2) HISOFFSET; 
LOWSOFFSET = CSADDR(1)}3 
HISOFFSET = CSADDR(2); 
PROGRAMSCOUNTER = CSADDR(Q); 
END; 
/* 65: GDP */ 
DO; 


DCL OFFSET BYTE; 
OFFSET = CONVERTSTOSEEX(RES (CSADDR(1)) 
CSBYTE(1)) 
PROmES HE > CSRYTN(2) OR OFFSET < 1 73 
DO; 


; 

EN 
CALL PRINTSERROR( ‘GD’ ); 

CALL INCSPTR(SHL(CSBYTE(®),1) + 4); 


END; 
ELSE PROGRAMSCOUNTER = CSADDR(OFFSET + 1); 


BOLD = GALLSTOP; 

CALLSTOP = CALLSTOP + SHL(CSADDR(Q),1) + 23 

IF CALLSTOP > RTNSBASE — 7 THEN 
CALL PATALSERROR( “CO” ); 

HSADDR(@) = CALLSBASE?3 

DO CTR = 1 TO CSADDF(2); 
HSADDR(CTR) = RES (CSADDR(CTR)); 

END; 

CALLSBASE = HOLD; 

CALL INCSPTR(SHL(CSADDR(@),1) + 2)3 

END; 
END; /* END OF CASE STATEMENT */ 
END; /* END OF DO FOREVER */ 
END EXECUTE; 


moe * 6 * 6 * 6 PROGRAM EXECUTION STARTS HERE * * ¥ * % ¥ %/ 


CALL MOVE(@@FCH, .HISFREESMEM,4); 

HISFREESMEM = MAXSMEMORY — HISFREESMEM; 
LOWSFREESMEM = CODESSTART + LOWSFREESMEM + 2; 
RINSBASE = HISFREESMEM; 

CALLSTOP,CALLSBASE = LOWSFREESMEM; 
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CALL PRINT(.(°NPS MICRO-COBOL INTERPRETER VERSION 2.257))3 
CALL PRINT(.( “EXECUTION BEGINSS”)); 

BASE = CODESSTART; 

PROGRAMSCOUNTER = BSADDR(®@)3 

GALL EXECUTE; 

END; 
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COMPUTER LISTING FOR MODULE RFADER NPS MICRO-COBOL 


$ TITLE( “NPS MICRO-COBOL COMPILER READER’) PAGEWITTH(8@) 
PAGELENGTH (62) 
READER: DO; 


/* COBOL CCMPILER — READER ay 
Ve NORMALLY LOCATED AT B@92H % / 
yet GLOBAL DECLARATIONS AND LITERALS ay 
/* THIS PROGRAM IS LOADED IN WITH THE PART 1 PROGRAM 
AND IS CALLED WHEN PART 1 IS FINISHED. THIS PROGRAM 
OPENS THE PART2.COM FIL® THAT CONTAINS THY CODE FOR 


PART 2 OF THE COMPILFR, AND READS IT INTO CORF. AT 
THE END OF TEE READ OPERATION, CONTROL IS PASSED TO 


TERE SFCOND PART OF THF PROGRAM. ef 
DECLARE 

mT LITERALLY “LITERALLY. 

ADDR ADDRESS INITIAL(1@@8), 

Del Teer SDECTARE , 

FCE(33) BYTE INITIAL(@,°PART2 COM’, 

2,2,09,9,0,0,09,2,09,2,0,2,2,2,0,2,9,0,2,8,@), 

I ADDRESS, 

PROC ieee “PROCEDURE’, 

START LIT "10908"; 


MON1: PROC(F,A) EXTERNAL; 
DCL F BYTE, A ADDRESS; 
END MON13 


MON2: PROC(F,A) BYTE FXTERNAL: 
men F BYTE, A ADDRESS; 
END MON23 


BOOT: PROC EXTERNAL; 
END BOOT; 


OPEN: PROC(FCB) BYTE; 
DCL FCB ADDRESS; 
RETURN MON2(15,FCB)3 

END OPEN; 


READ: PROC(ADDR) BYTF; 
DCL ADDR ADDRESS; 
CALL MON1 (26,ADDR)3 /* SET DMA ADDRESS */ 


RETURN MON2 (28,.FCB); /* READ, AND RETURN ERROR CODE */ 


END READ; 
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ERROR: PROC(CODE); 


END 


END; 


DCL CODE ADDRESS; 

CALL MON1(2,(H4IGH(CODE 
CALL MON1 (2, (LOW(CODE) 
CALL BOOT; 

ERROR} 


) 


)) 
)) 


ye PROGRAM EXECUTION STARTS HERE ad 


CALL MON1 (26,019@E); 
IF OPEN(.FCR) = 255 TEEN CALL FRROR(“°02’);3 
I = 01288; 
DO WHILS RFAD(I) = @; 
I = I + @88Q0H; 
END} 
CALL MON1 (26, 20828); /* RESET DMA ADDRESS */ 
CALL ADDR; 
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COMPUTER LISTING FOR MODULE BUILD NPS MICRO-COBOL 


PAGELFNGTEH( 62) 


BUILD: DO; 


/* 
/* 


COLOLSCOMPILER = BUILD 
NORMALLY LOCATED 


$ TITLE(’°NPS MICRO-COBOL COMPILER EUILD”) PAGEWIDTH(e8@) 


a 


AT 10H ae 


hee GLOBAL DECLARATIONS AND LITERALS a 


/* THIS PROGRAM TAKES THE CODE OUTPUT FROM THE CO80L 
COMPILEP AND BUILDS THE ENVIRONMENT FOR TRE COROL 


INTERPRETER */ 


DECLARE 


rT 

TRUE 

ADDR 

BASE 

BSADDR 

BSBYTR 

ROOT 

PUFFSEND 

CHAR 

CODESCTR 
CSADDR 

CSBYTE 
CODESNOTSSET 
CURSSYM 

BGT, 

EXT 

FALSE 

FCB 

FCBSRYTE 
FCBSBYTESA 
FILESTYPE (*) 
FOREVER 
FREESSTORAGE 
HASHSMASK 

I 
INTERPSADDRESS 
INTERPSCONTENT 
INTERPSFCB(33) 


oay TY 
HISOFFSET 


LITERALLY 
LIT 
ADDRESS 
ADDRESS, 
BASED 
BASED 

LIT 

Pair 

BAS ED 
ADDRESS, 
FASED 
BASED 
BYTE 
ADDRESS, 
ioe 

pick 

ee 
ADDRESS 
BASED FCB 
PesedD FCB (353) 
BYTE 

LIT 
ADDRESS, 
BYTE 
Brie, 
ADDRESS 
BASED 
BYTE 


BASED 
ADDRESS 


oer 


“LITERALLY “, 
ral aa: 
INITIAL(1@@H), 


BASE ADDRESS, 
BASE Cay Bern. 


1008’, 
ADDR BYTE, 


CODESCTIR ALIR=ESS, 
CODESCTR BYTE, 
INITIAL( TRUE), 


“DECLARE , 
‘28H’, 


INITIAL(5CB), 
RYIN.: 
BYTE. 
DATA .CINS ), 
“WHILE TRUE’, 


INITIAL(@FE), 


INITIAL(35@68), 
INTERPSADDRESS ADDRESS, 
INI TAO, CINTERP Cor’, 
Once .?)', 
INTERPSADDRESS (2) PYTE, 
INITIAL(ZQB), 





LOWSOFFSET ADDRESS 
LOADED tees 
MAXSMEMORY ADDRESS 
NEXTSSYM ADDRESS, 
NEXTSSYMSENTRY BASED NPXTSSYM 
POINT ADDRESS, 
COLLISION BASED POINT 
PROC LIT 

PROC SNAME (8 ) RYTE, 
READERSLOCATION ADDRESS 

Sr ledge 

SUBSFLAG Bias 

so MEOL PASE CURS oS) M 
SYMBOLSADDR BASED CURSSYM 
TOPSOFSMEMORY ADDRESS 


MON1i: PROC(F,A) EXTERNAL; 
DCL F BYTE, A ADDRESS; 
END MON13 


mone: PROC(F,A) EYTE EXTERNAL; 
DCL F BYTE, A ADDRESS; 
END MON2; 


PRINTSCHAR: PROC(CEAR); 
DCL CHAR BYTR; 
CALL MON1(2,CBAR); 
END PRINTSCBAR; 


CRLF: PROC; 
CALL PRINTSCHAR(13);3 
CALL PRINTSCHAR(1@);3 
END CRLF; 


PRINT: PROC(A);3 
DCL A ADDRESS; 
CALL MON1(9,a)3 
END PRINT; 


PRINTSNAME: PROC(ADDR); 
DCL ADDR ADDRESS; 
BASFE = ADDR; 
f= 255; 
ool CRLY; 
DO WHILE(BSBYTE(I := I +1) 
CALL PRINTSCPAR(BSBYTE(I 
TND3 
END PRINTSNAME; 


OPEN: PROC(A) BYTE; 
DCL A ADDRESS; 


Oe 


INITIAL(@QB), 
"108", 
INITIAL(1C82B), 
ADDRESS, 


ADDRESS, 
“PROCEDURE”, 


INITIAL(1C8@H), 
“A68", 
INITIAL(FALSF), 
(Mo PyYTE.. 

(1) ADDRESS, 
INITIAL (@B1908 ); 


oS “) AND (I < 8); 





RETURN MON2(15,A)3 
END OPEN; 


CLOSE: PROC(FCB); 
DCL FCB ADDRESS; 
IF MON2(16,FCB) = 255 TEEN 
ner 
CALL CRLF; 
CALL PRINT(.(°CLOSE ERROR ON MODULF $7))3 
CALL PRINTSNAME(FCB + 1); 
END; 
END CLOSE; 


REBOOT: PROC; 
ADDR = BOOT; 
CALL ADDR; 

END REBOOT; 


FATALSTRROR: PROC(RFASON); 
DCL RFASON ADDRESS; 
manu CRLF} 
CALL PRINTSC3AR(HIGH( REASON) );3 
CALL PRINTSCHAR(LOW (REASON))3 
CALL PRINTSNAME(FCB + 1)3 
GALL PRINT(.FILESTYPE); 
CALL REBOOT; 
END FATALSERROR; 


MOVE: PROC(FROM, DEST, COUNT); 
DCL (FROM,DEST,COUNT) ADDRESS, 
(F BASED FROM,D BASED DEST) BYTE; 
DO WHILE(COUNT := COUNT - 1) <> @FFFFH; 


ae 
FROM = FROM + 1; 
DEST = DEST + 15 
END; 
END MOVE; 


FILL: PROC(ADDR,CHAR,COUNT); 
DCL ADDR ADDRESS, 
(CHAR, ,COUNT,DEST BASED ADDR) BYTE; 
DO WHILE (COUNT := COUNT - 1) <> OFFH; 
DEST = CHAR; 
ADDR = ADDR + 13 
END; 
ND FILL; 


GETSCHAR: PROC BYTE} 
IF (ADDR := ADDR + 1) >= BUFFSEND THEN 
DO; 
IF MON2(20,FCB) <> @ THEN 


‘ 
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D0; 
CALL CRLF; 
CALL PRINT(.(°END OF INPUTS”) ); 
CALL RERCOT; 
END; 
ADDR = &@H» 
END; 
RETURN CHAR; 
END GETSCHAR; 
NEXTSCHAR: PROC; 
CRAR = GETSCEAR; 
END NEXTSCHAR; 


STORE: PROC(COUNT); 
DCL COUNT BYTE; 
IF CODFSNOTSSET THEN 
0} 
ChEL CRLF; 
CALL PRINT(.(’°CODE EPRORS”)); 
CALL NEXTSCEAR; 
RETURN 
END; 
moet = 1 TO COUNT; 
foBYTe = CHAR; 
CALL NEXTSCFAR; 
CODESCTR = CODESCTR + 13 
END; 
END STORE; 


INITSLOADSTABLE: PROC; 
PREESSTORAGE = .MEMORY; 
CALL FILL(FREESSTORAGE,2,34);$ 
NEXTSSYM = FREESSTORAGE + 323 
NUXTSSYMSENTRY = @;3 

END INITSLOADSTARLE; 


BUILDSSYMBOL: PROC; 
DCL TEMP ADDRESS; 
TEMP = NEXTSSYM; 
IF (NEXTSSYM := .SYMBOL(17)) > MAXSMEMORY THEN 
CALL PATALSFRROR( °PS”); 
CALL FILL(TEMP,G9,17);3 
END BUILDSSYMROL; 


MATCH: PROC} 
DCL (HOLD,I) BYTE; 
MOLD = 03 
feet = @ TO 7; 
ie HOLD = HOLD + PROCSNAME(I); 
POINT = FREESSTORAG® + SHL( (HOLD AND HASHSMASK),1);3 
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DO FOREVER; 
Peco GLislON = 9 THEN 


DO; 
GURsSSiM, COLLISION = NEXTSSYM; 
CALL BUILDSSYMEOL; 
DO I = @ TO 73 
SYMBOL(I + 8) = PROCSNAME(T); 
END; 
RETURN; 
END; 
ELSE 
DO; 
CURSSYM = COLLISION; 
I = 0; 
CO WEILE SYMBOL(I + &) = PROCSNAME(I); 
TP (I := 1 +1) > 7 THEN 
CO; 
CURSSYM = COLLISION; 
RETURN} 
END; 
ENT; 
END; 
Bown ts= COLLISION; 


END; 
END MATCH; 


STUFF: PROC; 


DCL (HOLD,TEMP) ADDRESS; 
HOLD = SYMBOLSADDR(1);3 
BASE = .TEMP; 


RSBYTE(@) = GETSCHAR; 
BSBYTE(1) = GETSCHAR; 
SYMBOLSADDR(1) = CODESCTR + TEMP - INTERPSADDRESS 5 
DO WHILE HOLE <> @; 
BASF = HOLD; 
FOLD = BSADDR; 
Hom = 1 TO 3; 


BSADDP = SYMBOLSADDR(I);3 
BASE = BASE + 2; 


END; 
END; 


CODESCTR = SYMBOLSADDR(1); 


END STUFF; 


COMPUTESOFFSETS: PROC; 
DCL TEMP ADDRESS; 
BASE = .TEMP; 


BSBYTE(@) 
BSBYTE(1) 
FISOFFSET 


LOWSOFFSET 


GETSCEAR; 

GETSCHAR} 

HISOFFSET + (TOPSOFSMEMORY - TEMP + 1); 
= CODFSCTR — INTERPSADDRESS —- 23 
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END COMPUTESOFFSETSs 


SUBR: PROC; 
men I BYTE; 
CALL STORE(1)3 
fot = 2 TO 7; 
PROCSNAME(I) = CHAR; 
CALL NEXTSCRAR} 
END; 
CALL MATCH; 
peri = 1 TO 3; 
CSADDR = SYMEPOLSADDR(I); 
CODESCTR = CODESCTR + 23 
END; 
IF SYMBOL(LOADED) = @ THEN 
SYMBOLSADDR(1) = CODESCTR - 6; 
END SUBR; 


GOSDEPENDING: PROC; 

CAL STORE(1); 

CALL STORE(SHL(CEAR,1) + 4); 
END GOSDEPENDING; 


PARAMETERS: PROC; 

CALL STORE(1)3 

CALL STORE(SHL(CHAR,1) + 2)3 
END PARAMETERS; 


BACKSSTUFF: PROC; 
DCL (HOLD,STUFF) ADDRESS; 
BASF = .HOLD; 
BOvl = 2 TO 3; 
ESBYTE(I) = GETSCHAR; 
END; 
DO FOREVER; 
PASE = EOLD + LOWSOFFSET; 
FOLD = BSADDR; 
BSADDR = STUFF; 
IF HOLD = @ THEN 
DO; 
CALL NEXTSCHAR; 
RETURN 5; 
END; 
END; 
END BACKSSTUFF; 


INITIALIZ®: PROC; 
DCL (COUNT,WHERE,HOWSMANY) ADDRESS; 
BASE = .WHERE; 
DO I = @ TO 3; 
RBSBYTF(I) = GETSCHAR; 
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END; 


TOPSOFSMEMORY —- HISOFFSET THEN 


IF WEERE > 
BASE = WHERE - HISOFFSET - 13 
ELSE 
BASE = WHERE + LOWSOFFSET - 13 
DO COUNT = 1 TC HOWSMANY; 
RSBYTE(COUNT) = GETSCRAR; 
END; 
CALL NEXTSCPAR; 
END INITIALIZE; 
TERMINATE: PROC; 
Gb f BYTE, TEMP ADDRESS; 


IF SUBSFLAG THEN CSBYTE = EXT; 


ELSE 
CODE 
io = 
CALL 
CALL 
SUBS 
no | 


END; 
END TERM 


STARTSCO 
CODE 
PF S 
ELSE 


meoy tho] STP; 

SCTR = CODESCTR + 13 
OFFER; 

PRINTSNAME(FCER + 1); 
PRINT(.(% LOADEDS’))3 
FLAG = FALSE; 

= @ TO 15; 


POINT = FREEFSTORAGE + 2 * T; 


DO WHILE COLLISION <> 2; 
CURSSYM = COLLISION} 
IF SYMBOL(LOADED) = 


QO; 


CODES TSS#” ,SYMEOL( LOADED) ,SUBSFLAG 


TRUE; 


p 


aN 


CALL COMPUTESOFFSETS; 


SYMEBOLSADDR(2) = LOWSOFFSET; 


SYMBOLSADDR(Z) = HISOFFSET; 
CALL CLOSE(FCB); 


CALL MOVE( .SYMBOL(2),FCB + 1,8); 


FOBSBYTFSA(Z2) = @; 
CALL FILL(FCB + 12,8,4); 


ADDR = 102433 
IF OPEN( FCB) 


GALL FATALSERROR( “OP” ); 


= eos eee 


CALL NEXTSCHAR; 


PETURN; 
END; 
POINT = COLLISION; 


END; /* DO WHILE COLLISION <> 2 */ 


ye )0 1 = 0 TO 15 */ 
INATE;3 

DF: PROG; 

SNOTSSET = FALS¥3 


UBSFLAG TEEN CALL STUFF; 
DO; 
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END; 


ISBYTE(G) 
or ola de) 
COD*SCTR 


CALL NEXTSCHAR; 
END STARTSCODE; 


BUILD: PROC; 


DCL 
F2 
FS 
F4 
FS 
F6 
F? 
Fe 
F9 
¥10 
Fil 
¥le2 
¥15 
SBR 
GDP 
PAR 
INT 
EO. 
TER 
SCD 


bE 
ete 
is 
bit 
i 
LIT 
ib T 
ee 
BET 
Ok 
iT 
tnt 
pe 
ie 
ee 
bit 
ett 
bit 
EIT 


’ 


’ 


. 
WM Ae 
PHM 
® &® 


x 
’ 


. oN 
DH OV 
moa 
a 


x 


x x’ 
MN O (nn 
CA CA > +2 
. 8 * 
ee) 2 olU ehUOUCSS - = @ 


“ 
x 


. oN 
NAA 
O Cn wp 
.oN 


Feu 


’ 


. 
MO O) 
(© © 

. 


% 


‘ 
~j 
®& 

‘ 


DO FOREVER; 


FLSE 
ELSE 
ELSE 
WLSE 
ELSE 
ELSS 
SLSE 
ELSE 
FLSE 
FLSE 
ELSE 
ELSE 
FLSE 
ELSE 
FLSE 
ELSE 
ELSE 
FLSE 


ie 
IF 
en 
If 
[® 
IF 
IY 
[¥ 
ik 
IF 
I¥ 
IF 
IF 
IF 
ie 
IF 
IF 
He 
IF 
DO; 


CHAR 
CHAR 
CHAR 
CHAR 
CHAR 
CEAR 
CHAR 
CHAR 
CHAR 
CEA 
CHAR 
CHAR 
CHAR 
CHAR 
CHAR 
CHAR 
CHAR 
CHAR 
CHAR 


CALL 


ee 
FS 
F4 
Ns 
F6 
ee 
¥8 
FQ 
H1¢ 
ele 
ele 
F138 
SBR 
SER 
GDP 
PAR 
BST 
INT 
TER 


lord t t WUNANNNANNNANANNANAN 


aN 
THEN 
TEEN 
THEN 
THEN 
THEN 
THEN 
TEEN 
THEN 
THEN 
THEN 
THEN 
TOEN 
THEN 
THEN 
THEN 
THEN 
TEEN 
TEEN 


TERMINATES 
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GETSCHAR; 
GETSCHAR; 
INTERPSCONTENT; 


CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 


STORE 
STORE 


( 
( 
( 
STORE 
STORE ( 
STORE ( 
STORE ( 
STORE ( 
STORE ( 
STORE ( 
STORE ( 
STORE ( 
STORE( 
SURBR; 


GOSDEPENDING: 
PARAMETERS; 
BACKSSTUFF; 
INITIALIZE; 





IF NOT SUBSFLAG THEN 
Be 
CALL COMPUTESOFFSETS; 
CALGWCLOSE( FOS)$ 
RETURN; 
END; 
END; 
FLSE If CHAR = SCD THEN CALL STARTSCODRE; 
FLSE 
Los 
CALL CRLF; 
CALL PRINT(.(°LOAD ERRORS”) )3 
CALL NEXTSCHAR; 
END; 
END; 
END EBUILD; 


Pe PPOGRAM EXECUTION STARTS HERE */ 


eALL CRLF; 
CALL PRINT(.(’°NPS MICRO-COEOL LOADER VERS 2.6$°)); 
FCBSBYTFSA(32) = @;3 
CALL MOVE(.(°CIN’,@,8,2,8),FCR + 9,7)3 
IF OPEN(FCB) = 255 THEN 
DO} 
CALL CRLF; 
CALL PRINTSNAME(FCB + 1)3 
CALL PRINT( .FILESTYPE); 
CALL REBOOT; 
END$ 
CALL NEXTSCEAR; 
CALL INITSLOADSTABLS; 
SALL BUILD; 
CALL MOVE( .INTERPSFCB,FCB,22Z); 
FCBSRYTESA(S32) = 0; 
IF OPEN(FCB) = 255 THEN 
DO} 
CALL CRLF; 
CALL PRINT(.(’°CINTERP.COM NOT FOUNT $°) 
CALL REBOOT; 
END; 
CALL MOVE(READERSLOCATION, &@H, 888); 
CALL MOVE( .HISOFFSFT,@FCE,4)3 


dl 


ADDR = &@F; 
CALL ADDR; /* BRANCH TO &8@H */ 
END; 
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COMPUTER LISTING FOR MODULE INTRDR NPS MICRO-COBOL 
$ TITLE(’NPS MICRO-COBOL COMPILER INTRDR’) PAGEWIDTE(@@) 
PAGELENGTH (62) 
INTRDR: DO; 
Vie COBOL COMPILER ~- INTRDR By) 
/* NORMALLY LOCATED AT @@ & x / 
[* GLOBAL DECLARATIONS AND LITERALS * / 


/* THIS PROGRAM IS CALLED BY THE BUILD PROGRAM AFTER 
CINTERP.COM HAS BEEN OPENED, AND READS THE CODE INTO MEMORY 
a 


DECLARE 
LIT LITERALLY SE ERALLY , 
DCL Pa “DECLARE”, 
i ADDRESS INITIAL (@980H), 
INTERP ADDRESS INITIAL(1@0E), 
PROC tlds “PROCEDURE “ , 
Siakt LIT “1008; 


MON1:PROC(F,A) EXTERNAL; 
DCL F BYTE, A ADDRESS; 
END MON1;5 


MON2: PROC(F,A) BYTE EXTERNAL; 
DCL F 3YTE, A ADDRESS; 
END MON2; 


DO WHILE 13 
CALL MON1 (26,(I := I + @@8@0H)); /* SET DMA ADDRESS */ 
IF MON2 (28,5CH) <> @ THEN 
CALL INTSRPE; 
END; 
END; 
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SOMPUTER LISTING FOR MODULE D®CODE NPS MICPO-COBOL 


$ TITLE(’NPS MICRO-COBOL COMPILER DECODEF’) PAGFWITTY(e@) 


PAGELENGTE(6@) 
DFCODE: DO; 


/* COBOL COMPILER - DECODE ae / 


Le NORMALLY LOCATED AT 1035 ae 


ve GLOBAL DECLARATIONS AND LITERALS ey 


V~ THIS PROGRAM TAKSS THE CODE OUTPUT FROM TEE COBOL 
POMPILER AND CONVERTS IT INTO A READABLE OUTPUT TO 


FACILITATE DEBUGGING */ 


DECLARE DCL LITERALLY 
LI? LITERALLY 
ADDR ADDRESS 
BUFFSEND LIT 
BYTESCOUNT ADDRESS 
RYTESRI Eek, 
PYTES LOW BYTE, 

CHAR BASED ADDR 
CSADDR BASED ADDR 
FCB ADDRESS 
ReSoBYTS BASED FCB (1) 
FILESTYPE(*) BYTE 

I Bae. 

PROC LIT 


MON1: PROC (F,A) EXTERNAL; 
DCL ¥ BYTS, A ADDRESS; 
END MONI; 


MON2: PROC (F,A) BYTE EXTERNAL; 
DCL F BYTE, A ADDRESS; 
END MON2; 


BOCT: PROC EXTERNAL; 
END BOOT; 


PRINTSCRAR: PROC(CHAR)}3 
Mol CHAR BYTE; 
CALL MON1(2,CEAR); 
END PRINTSCHAR;3 


“DECLARE “ , 
Beemer ly ~ . 
INITIAL (1287), 
“@FFE’, 

EN iA G ) 


By ee 

ADDRESS, 
INITIAL (5CB), 
Bik. 

DATA (“CIN”), 


“PROCTDURE’S 





CRLF: PROC; 
CALL PRINTSCHAR(13); 
CALL PRINTSCHAR(12); 
END CRLF; 


P: PROC(ADD1);3 
HepeADD] ADDRESS, C BASED ADD1 (1) BYTS; 
GOLL CRLF; 
wont = 2 TO 2; 
CALL PRINTSCHAR(C(I))3 
END} 
CALL PRINTSCBAR(’ “”)3 
END P; 


GETSCHAR: PROC RYTRE; 
IF (ADDR := ADDR + 1) > BUFFSEND TEEN 
DO; 
IF MON2(20,FCB) <> @ TEEN 
DO; 
CALL P(.(°END’)); 
SWDL BOOT; 
END; 
ADDR = &@4; 
END3 
RETURN CHAR} 
END GETSCFRAR; 


DSCHAR: PROC (OUTPUTSEYTE); 
DCL OUTPUTSBYTE BYTE 
IF OUTPUTSRYTE < 18 THEN 
CALL PRINTSCHAR(QUTPUTSBYTE + 32H); 
ELSE 
CALL PRINTSCFAR(OUTPUTSBYTF + 3745); 
END DSCEAR;} 


me PROG (COUNT); 
DCL(COUNT,J) ADDRESS; 
perg=1 TO COUNT; 
CALL DSCHAR(SHR(GETSCHAR,4))3 
CALL DSCHAR(CHAR AND 9FH);3 
CALL PRINTSCERAR(’ “); 
END; 
END D3 


PRINTSREST: PROC; 


oe 





DCL 
F2 
FS 
F4 
FS 
iG 
ne? 
¥8 
FQ 
F190 
F1l 
el 
SBR 
F1S 
GDP 
PAR 
INT 
Bot 
Uy 
SCD 


IF 
IF 
I? 
IF 
IF 


IF 
IF 
If 
IF 
I¥ 
I? 
IF 
LF 
iF 


Le 


LIT 
mi 
ae 
at 
Dit 
1G 
ot 
pit 
LIT 
lips 
LIT 
ror 
iT 
LIT 
ir 
1 a 
i 
DL 
ELT 


CRAR 
CHAR 
CREAR 
CFAR 
CHAR 
CHAR 
CFAR 
CRAR 
CHAR 
CFAR 
CHAR 
CHAR 
CHAR 
CEAR 
CHAR 

DO; 


END; 
CEAR 
DO; 


END; 
CHAR 
DO; 


Oo, 
70 3 


¥2 
FS 
¥4 
FS 
Hs 
wr? 
me 
¥9 
¥1@ 
ee 
¥l2 
Eire 
OBR 
S BR 
CDE 


TREN 
THEN 
TEEN 
THEN 
THEN 
TREN 
THEN 
TEEN 
THEN 
TPEN 
TEEN 
THEN 
TEEN 
TEEN 
THEN 


RETURN; 

DO; CALL 
DO; CALL 
DO; CALL 
DO; CALL 
DO; CALL 
DO; CALL 
DO; CALL 
DO; CALL 
DO; CALL 
DO; CALL 
DO; CALL 
DO; CALL 
DO; CALL 


I WANANAN ANNAN ANNA 


CMLL D(1); 
CALL D(SEL(CHAR,1) 
RETURN; 


8); 


PAR THEN 


CAE. D1) 3 
CALL D(SHL(CHAR,1) + 1)3 
RETURN; 


INT THEN 


EYTESCOUNT 
GaLL DCS); 


0; 
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RETURN ; 
RETURN 5 
RETURN 5 
RETURN; 
RETURN; 
RETURN; 
RETURN; 
RETURN; 
RETURN 3 
RETURN; 
RETURN; 
RETURN; 


> RETURN; 


ENT; 
END; 
END; 
END; 
END; 
END; 
END; 
END; 
END; 
END; 
END; 
END; 


END; 





ByawsLowe=- CHAR; 
CALL D(1)3 
BYTESEI = CEAR; 
BYTESCOUNT = BYTESHI}3 
RYTESCOUNT = SHL(BYTESCOUNT,&) + BYTFSLOWS 
GALL DCBYTESCOUNT); 
RETURN; 
END; 
IF CHAR = BST THEN 
DIO; 
CALL D(4);3 
RETURN} 
END; 
IF CHAR = TER THEN 
DO; 
CELL D(2); 
OMLi P(.( END’ )); 
CALL BOOT; 
END? 
IF CFAR = SCD TREN 
ChE GeDI 2); 
RETURN 
ENT 
Gant P(. ns REX’ )) 
END PRINTSREST; 


/* PROGRAM EXECUTION STARTS HERE */ 


FCBSBYTE(32), FCBSBYTE(@) = 
ioei=9 TO 23 

FCBSEBYTE(I+9)=FILESTYPE(I); 
END; 


meeMON2(15,FCE)=255 THEN DO; CALL P(.(°22Z2")); 
CALL BOOT; END; 


DO WHILE 13 
IF GETSCHAR <= 70 THEN DO CASE CHAR; 
; /* CASE @ NOT USED */ 
OLE P(.(°ADD’)); 
GALL P(.(°SUB™)); 
ment Pi. ( MUL’ )); 
GALL P(.( DIV’ )); 
GALL P(.( NEG”)); 
GLE P(.(°STP’)); 
WNLL P(.(°STI” )); 
CALL P(.(°EXT”)); 
GALL P(.(°RND’)); 
GMELL P(.(°RET”)); 
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CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 
CALL 


gtr uUdU id Ud UU foo U UU UO dU UU oO OU VU UO UO OO Oo SU TOU Oo oo UU fo So tod ‘Oo 
OE OO ON OR ON LO fm alin, fin, Gn, GO, on, LO Gn, Btn, GO, Gn, tn, GO, Gn, GO Gn, Gn, GO, Gy, ain, GO Gn, Gn, Gy Gy Gy A i in, Py ny fy i, A ei, 


oie 9 





GALL P(.( MED“)); 
CALL P(.(°MNE”)); 
GALL P(.(°SER’)); 
Carn Pi. ¢°GDP“)); 
GALL P(. (WAR ’)); 
CALL P(.( INT”) )3 
GHEL P(.(°BST’))3 
CALL P(.( TFR )); 


CALL P(.(°SCD’))$ 
END; /* OF CASE STATEMENT */ 
CALL PRINTSRESTS 
END; /* END OF DO WHILE */ 
END; 
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GRAMMER FOR PART ONE NPS MICRO-COBOL 


OPTIONS (BNF TABLES LALR AINPUT EXTRAT NOGPOST COMPACT) 


ODNIMNOLPWNNN FP 


CPROGRAM> ::= <ID-DIVD <E-DIV> <D-DIV> PROCEDURE 

Seve hi¥> ::= IPPNZTIFICATION DIVISION . PROGRAM-ID 
<COMMENTD . <ID-LIST> 

<ID-LIST> ::= <AUTHD <INS> <DATED <SECD 

CAUTE> ::= AUTHOR . <COMMENTD . 


SEUr TY 

<INSD> ::= INSTALLATION . <COMMENTD 
<EMPTY> 

CDATE> ::= DATE-WRITTEN . <COMMENTD 
<EMPTY> 


<SEC> ::= SECURITY .~. <COMMENTD . 


<EMPTY> 
<COMMENTD 3s3= <INPUTD 
<COMMENT>D <INPUTD 
ENVIRONMENT DIVISION . CONFIGURATION 
SeGPlONse= ~o2C-O8J> <I-0> 
<EMPTY> 
Serc-OSJ> ::= SOURCE-COMPUTER . <COMMENT>D <DE3tGG> 
CEVEGI=COMPULEA =. <COMMENT>D . 

<DEBUG> ::= DEBUGGING MODE 

<EMPTY> 
<1-0> ::= INPUT-OUTPUT SECTION . FILE-CONTROL 

CPT US=CON TROLS LiS > <1cp 
<EMPTY> 
Seu —CONTROL=—LIST> ::= <FILE-CONTROL-ENTRY> 
<FILE-CONTROL-LIST> 
CFILE-CONTROL-ENTRY > 


<¥-DIVD 


SFILE-CONTROL-ENTRYD 33:= SELECT <ID> <ATTRIBUTE-LISTD . 


Sao tRIBUTE-LIST> 2::= <ONE-ATTRIS> 
Cebort sULe—LIST> <ONE-ATTPIBD> 
CONE-ATTRIBD 33= ORGANIZATION <ORG-TYPED 
ACCESS <ACC-TYPED <RELATIVED 
ASSIGN <CINPUT> 
<ORG-TYPED ::= SEQUENTIAL 


RELATIVE 
INDEXED 
CACC-TYPED ::= SEQUENTIAL 
RANDOM 
CRELATIVED s:= RELATIVE <ID> 
<EMPTY> 
fone s>=> I-O-CONTROL . <SAME-LISTD 
ete: Yee 


<SAME-LIST> ::= <SAME-ELEMENT> 
<SAME-LIST> <SAME-ELEMENT> 
<SAME-FLEMENT> ::= SAME <ID-STRING>) 


wee 





41 
42 
435 
43 
44 
45 
46 
4” 
48 
46 
£9 
o@ 
1 


& 
~ 


53 
94 
ake) 
56 
7 


ao 
oY) 
6¢ 
1 
62 
635 
64 
65 


66 
66 
Oy 
68 
EQ 
78 
71 
72 
73 
74 
wo 
76 
c'? 
76 
79 
82 


Be 
835 
84 
85 
86 


<ID-STRINGD s:= <IDD 
Cite stRING> <ID> 
<D-DIV> s:= DATA DIVISION . <FILE-SECTIOND <WORK> 
<LINKD 
<FILESSECTION> :s= FILE SECTION . <FILE-LIST> 
EMP ILD 
Sulce—-PISt> 23]  CrILES> 
Crib k=LiSt > <FILES > 
CFILES> ::= FD <ID> <FILE-CONTROLD 
CRECORD-DESCRIPTION>D 
<FILE-CONTROLD 3:= <FILE-LST> 
<EMPTY> 
<FILE-LSTD ::= <FILE-ELEMENTD 
<FILE-LSTD> <FILE-ELEMEN TD 
<PILE-ELEMENT>D :s:= BLOCK <INTEGERD RECORDS 
RECORD <REC-COUNT> 
LABEL RECORDS STANTARD 
LABEL RECORDS OMITTED 
VALUE OF <ID-STRING> 
<REC-COUNT>D :3:= <INTEGERD 
<INTEGERD TO <CINTEGERD 
CWORK> ::3= WORKING-STORAGE SECTION . 
<RECORD-DESCRIPTIOND 


EMPEY? 

<LINKD> :3:= LINKAGE SECTION . <RECORD-DESCRIPTIOND 
<EMPTYD 

SrmcORD-DESCRIPTION> *::= <LEVEL-ENTRY> 


<RECORD-DESCRIPTION> 
CLEVEL-ENTRYD 
CLEVEL-ENTRYD ::= <INTEGERD <DATA-ID>D <REDEFINESD 
<DATA-TYPED . 
SVATA=-ITD> 2::= <ID> 


YILLER 
CREDFFINESD ::= REDEFINES <ID> 
<EMPTYD 
CDATA-TYPE> ::= <PROP-LIST> 
CEE i > 
SeaOP=LIST> :s= <DATA-FLEMENT>D 


SSROb—tlot> (DARS ELEMENT > 
CDATA-ELEMENTD 3:= PIC <INPUTD 
USAGE COMP 
USAGE COMP-3 
USAGE COMPUTATIONAL 
USAGE DISPLAY 
SIGN LEADING <SEPARATED 
SIGN TRAILING <SEPARATE> 
OCCURS <INTEGERD INDEXED <ID> 
OCCURS <INTEGER> 
SYNC <DIRFCTION> 
VALUE <LITERALD 
<DIPFCTIOND :s:s= LEFT 
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87 RIGHT 


Bc “EME dL? 
89 CSEPARATE>D ::3:= SEPARATE 
9@ <EMPTY> 
aL CLITERALD ::= <INPUTD 
92 <LIT> 

93 ZERO 

94 SPACE 

95 QUOTE 


96 <INTEGERD ::= <INPUTD 
97 Mep> 2::= <INPUTD 


Note that the options list contains the item NOGPOS". 
This elimenats the hoal symbol _{_ from being added to 
the grammer of part one. In pdart two the hoal symbol is 
used as an end of file symbol (EOF). 
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GRAMMER FOR PART TWO NPS MICRO-COEROL 


OPTIONS (3NF TABLES LALR AINPUT EXTRAT COMPACT) 


1 <P=DIV> ::= PROCEDURE DIVISION <USINGD . <PROC-BQDY> 
eC <USINGS s:= USING <ID-STRING> 

3 <EV EP ie 

4 Ser SStRING> ?:= <EDD> 

5 <PP—-STRING>D <ID> 

6 <PROC-BODY> ::= <PARAGRAPH> 

? <PROC-BODY> <PARAGRAPED 

8 <PARAGRAPH> ::= <IDD . 

9 GED «eSSENDTENCE-LIST> 

12 <i? SECTION . 

at <SENTENCE$LIST> :3:= <SENTENCED . 

ine <SENTENCE-LIST> <SENTENCED 
13 <SENTENCED ::= <IMPERATIVED 

14 <CONDITIONALD 

5 ENR <i <OrT—ID> 

16 Mase bRALIVED *s="ACCEPT <SUBID> 
ae <ARITEMETIC> 

18 CALL <CALI-LIT> <USING> 

a CLOSE <CLCSE-LST> 
£0 <FILE-ACT> 
oi DISPWAY <DISPLAY-LST> 
Ze Dict “Disk LAY=LoST> with NO 
me ADVANCING 

295 EXIT <PROGRAM-ID> 
24 GO <ID> 
25 GO <ID-STRING> DEPENDING <ID> 
ZO Mowe <li t7ID> 10 <SUPID> 

Zr CPEN <ACT=-LSTD 
28 PMREORM <1D> <THRUD <TINISH> 
eo STOP <TERMINATED 
oe <CLOSE-LST> ::= <ID>D 
o1 SChOs B-Lot> <1D> 

32 CDISPLAY-LST> ::= <LIT/ID> 
ore <DilswoemeLstT> <LIT/ID> 

54 SeGI-LST> 3:3= <TYPE=ACTIOND <OPEN-LST> 

oO CAG iol Ti Pear LT ION> <OPEN-LSTD> 
06 SGEENSLSE> ¢:= <ID> 
Oo? SORPNeion> <I D> 

08 <FINISHD ::= <L/ID> TIMES 

39 <STOPCONDITIOND 

48 <VARYINGD <ITERATIOND <STOPCONDITION> 
41 <EMPTY> 

42 <STOPCONDITION>D ::= UNTIL <CONDITION>D 


43 <VARYINGD ::= VARYING <SURID> 
44 <ITERATIOND ::= <FROMD <BYD 
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45 
46 
47 
47 
48 
49 
52 
=O 
S31 
Sal 
a 
a5 
54 


56 
a 
58 
98 
99 
99 
ES 
61 
61 
62 
62 
635 
63 


65 
66 
67 
68 
EQ 
70 
71 
72 
73 
74 
75 
76 
77 
78 
79 
80 
e1 
82 
83 
e4 
85 
86 
e7 


<FROM> ::= FROM <L/ITD> 
SBveec 2= BY <L/1 D> 
SCONDITIONALD> ::= <ARITHMETICD> <SIZE-ERROR> 
CIMPERATIVE> 
Sol bea a> SINVALIDD <IMPPRATIVE> 
<READ-ID> <SPECIAL> <IMPTRATIVED 
<IF-NONTERMINALD <CONDITIOND 
CoE bot> <iP=Lol> END-IF 
<IF-NONTERMINAL> <CONDITIOND 
Shisisi > END=IF 


CIF$LST> 2:= <STMT-LST> 
NEXT SENTENCE 
<ELSED ::= ELSE 
SARI DaVETIC> 3:= ADD <ADD-LST> TO <SUBID> <ROUND> 


ADD <ADD-LSTOGIVING <SURID> <ROUNDD 
DIVIDE <L/ID> INTO <SUBID> <ROUND> 
Diavwbiee<h/ID> BY <SUBID> GIVING 
<SUBID> <ROUND> 
DiViln <L71D> INTO <SUBTDS GIVING 
<SUBID> <ROUND> 
MULTIPLY <L/ID> BY <SURBID> <ROUND> 
MULTIPLY <L/ID> BY <SUBID> GIVING 
<SUBID> <ROUND> 
SUPTRACT <SUB-LST> FROM <SUBID> 
<ROUND> 
SUBTRACT <SUB-LST> GIVING <SUBID> 
<ROUND> 
COMPUTE <SUBID> = <ARITH-EFXP>. 
<EA ie 
<ADD-LST> <L/ID> 
<SUB<-LST> ::= <L/IDD> 
<SUB-LST> <L/ID> 
<ARITE-EXP> ::= <TERMD 
<ARITH-EXP> + <TERMD 
<ARITH-EXP> -— <TERM> 
+ <TERM> 
— <TERM> 
<TFRM> ::= <PRIMARYD 
<TERM> * <PRIMARYD 
<TERM> / <PRIMARY>D 
<PRIMARY> ::= <PRIM-ELEMD 
<PRIMARY> ** <PRIM—FPLEM> 
<PRIM-ELEM> ::= <L/ID> 
( <ARITH-EXP> ) 
<FILE-ACT> ::= DELETE <ID> 
REWRITE <ID> 
WRITE <ID> <SPECIAL-ACT> 
<CONDITION>D ::= <BTERM> 
<CONDITION> OR <BTERM> 
<BITRMD ::= <BPRIMD 
<BTERM> AND <BPRIM> 


<ADD-LST> 
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ES 
89 
9¢ 
9O1 
92 
95 
94 
95 
96 
97 
98 
99 
122 
121 
182 
123 
104 
a5 
106 
127 
108 
129 
112 
fii 
P12 
113 
114 
a 5 
116 
17 
£18 
eo 
120 
lragl 
122 
123 
124 
Eeo 
LO 
Le? 
128 
129 
13 
131 
152 
1535 
154 
#SD 
1356 
1357 
158 


<BPRIM> ::= <LIT/ID> 
<LIT/IDD> <NOT> <COND-TYPE> 
( <RTERMD ) 
<COND-TYPE> ::= NUMERIC 
ALPHABETIC 
<COMPARED <LIT/ID> 
<NOT> ::= NOT 
<EMPTY> 
<COMPARED ::= GREATER 
LESS 
TOQUAL 


1IANVW 


ROUNDED 
<EMPTYD 
<TERMINATED :3:= <LITERAL> 
RUN 
<SPECIAL> ::= <INVALIDD 
END 
<OPT-IDD :3:= KSURIDD 
<EMPTY> 
<STMT-LSTD 3:= <IMPFRATIVED 
CSTMT-LSTD> <IMPERATIVED 
<CONDITIONALD 
<STMT-LST> XCONDITIONAL> 
<TERUD ::= TERU <ID> 
<EMPTY>D 
<INVALID>D ::= INVALID 
<SIZE-ERRORD ::= SIZE ERROR 
<SPECIAL-ACT> :3:= <WHEND ADVANCING <HOW-MANY>D 
<EMPTYD 


<ROUND>D 3:3: 


<WHEND ::= BEFORE 
AFTER 
<RFOW-MANYD ::= <INTEGFRD 
PAGE 
<TYPF-ACTIOND ::= INPUT 
OU Or 
I-0 
<SUBID> ::= <SUBSCRIPT> 
<ID> 
<INTEGERD ::= <INPUTD 
<1D> ::= <INPUT> 
<L/ID> 2::= <INPUT> 
<SUBSCRIPT> 
ZERO 
<SUBSCRIPT> s:= <ID> ( <SUBSCRIPT-LS™ ) 
<SUBSCRIPT-LST> ::= <INPUT> 
<SUBSCRIPT-LST> , <INPUT 
<CALL-LIT> ::= <LITD 
CNN-LITY 3::= CLITD 
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139 SPACE 


14¢ QUOTE 

141 CLITERALD ::= <NN-LITD 
142 <INPUTD 
143 ZERO 

144 SH t/ID> ::= <L/ID> 

145 <NN-LITD 
146 <PROGRAM—ID> ::= <ID> 
147 <EMPTY>D 


148 <CREAD-ID> ::= READ <ID> 
149 <IF-NONTERMINALD ::= IF 


Note that the options list does not contain the item 
NOGPOST. This causes a goal Symbol _!_ to be added to 
the grammer at the end of production one. This syrbol is 
used as the end of file symbol (EOF). Part one uses the 
mevroneal NOGPOST to surpress the generation of the goal 
symbol since an FOF is not wanted at the end of part one. 





1g. 
ai. 
Te 
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